git.fiddlerwoaroof.com
Browse code

Make more robust and update interface

fiddlerwoaroof authored on 25/11/2016 10:17:55
Showing 9 changed files
Makefile
History View file @ 79f9884
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,2 @@
1 
+all:
2 
+	sbcl --load deploy.lisp
alimenta-feed-archive.asd
History View file @ 79f9884
... ... 
@@ -3,14 +3,16 @@
3 3 
   :author "Fiddlerwoaroof <fiddlerwoaroof@howit.is>"
4 4 
   :license "MIT"
5 5 
   :depends-on (#:alexandria
6 
-               #:alimenta
7 
-               #:fwoar.lisputils
8 
-               #:ironclad
9 
-               #:local-time
10 
-               #:serapeum
11 
-               #:uiop
12 
-               #:ubiquitous
13 
-               #:yason)
6 
+	       #:alimenta
7 
+	       #:fwoar.lisputils
8 
+	       #:ironclad
9 
+	       #:local-time
10 
+	       #:serapeum
11 
+	       #:ubiquitous
12 
+	       #:uiop
13 
+	       #:yason)
14 14 
   :serial t
15 
-  :components ((:file "feed-archive")))
15 
+  :components ((:file "tools")
16 
+	       (:file "yason-encoders")
17 
+	       (:file "feed-archive")))
16 18
archive-root/index.html
History View file @ 79f9884
... ... 
@@ -1,51 +1,58 @@
1 1 
 <!DOCTYPE html>
2 2 
 <html lang="en">
3 
-<head>
4 
-  <meta charset="UTF-8">
5 
-  <title></title>
6 
-  <base href="<XXX: YOUR BASE URL HERE>" />
7 
-  <link rel="stylesheet" href="style.css" />
8 
-</head>
9 
-<body>
10 
-  <div id="container" v-cloak>
11 
-    <div class="left">
12 
-      <span class="pull-time">{{pull_time}}</span>
13 
-      <!--<div v-for="url in feed_urls">{{url}}</div>-->
14 
-      <div v-for="feed in feeds">
15 
-        <a v-on:click="get_feed(feed.path)">
16 
-          <span class="feed_url">{{feed.title}} &lt;{{feed.url}}&gt;</span>
17 
-        </a>
18 
-      </div>
3 
+  <head>
4 
+    <meta charset="UTF-8">
5 
+    <title></title>
6 
+    <base href="<XXX: YOUR BASE URL HERE>" />
7 
+    <link rel="stylesheet" href="style.css" />
8 
+  </head>
9 
+  <body>
10 
+    <div id="container" v-cloak>
11 
+      <div class="left">
12 
+	<div class="feeds">
13 
+	  <span class="pull-time">{{pull_time}}</span>
14 
+	  <!--<div v-for="url in feed_urls">{{url}}</div>-->
15 
+	  <div v-for="feed in feeds">
16 
+	    <a class="feed-link" v-on:click="get_feed(feed.path)" v-if="has_items(feed)">
17 
+	      <div class="title">{{feed.title}}</div>
18 
+	      <div class="url">
19 
+		&lt;{{feed.url}}&gt;
20 
+	      </div>
21 
+	    </a>
22 
+	  </div>
23 
+	</div>
19 24
20 
-      <div v-if="current_feed.title !== null" class="current_feed">
21 
-        <h2>{{current_feed.title}}</h2>
22 
-        <h3>{{current_feed.link}}</h3>
23 
-        <div>{{current_feed.description}}</div>
24 
-        <ul>
25 
-          <li v-for="item in current_feed.items | orderBy 'path' -1">
26 
-          <a v-on:click="get_item(item.path)">
27 
-            <span class="feed_url">{{item.title}}</span>
28 
-          </a>
29 
-          </li>
30 
-        </ul>
25 
+	<div v-if="current_feed.title !== null && current_feed.items.length > 0" class="current_feed">
26 
+	  <h2>{{current_feed.title}}</h2>
27 
+	  <h3>{{current_feed.link}}</h3>
28 
+	  <div>{{current_feed.description}}</div>
29 
+	  <ul>
30 
+	    <li v-for="item in current_feed.items | orderBy 'path' -1">
31 
+	      <a v-on:click="get_item(item.path)">
32 
+		<span class="feed_url">{{item.title}}</span>
33 
+	      </a>
34 
+	    </li>
35 
+	  </ul>
36 
+	</div>
31 37 
       </div>
32 
-    </div>
33 
-    <div class="right">
34 
-      <div v-if="current_item.title !== null">
35 
-        <h2>
36 
-          <a href="{{current_item.link}}">{{current_item.title}}</a>
37 
-        </h2>
38 
-        <h3>{{current_item.author}}</h3>
39 
-        <div>{{{  item_content }}}</div>
38 
+      <div class="right">
39 
+	<div v-if="current_item.title !== null">
40 
+	  <h2>
41 
+	    <a href="{{current_item.link}}">{{current_item.title}}</a>
42 
+	  </h2>
43 
+	  <h3>{{current_item.author}}</h3>
44 
+	  <div>{{{  item_content }}}</div>
45 
+	</div>
40 46 
       </div>
41 47 
     </div>
42 
-  </div>
43 48
44 
-  <script>
45 
-    baseUrl = 'current'
46 
-  </script>
47 
-  <script src="vue.js"></script>
48 
-  <script src="purify.js"></script>
49 
-  <script src="run.js"></script>
50 
-</body>
49 
+    <script>
50 
+      baseUrl = 'current'
51 
+    </script>
52 
+    <script src="vue.js"></script>
53 
+    <script src="purify.js"></script>
54 
+    <script src="es6-promise.min.js"></script>
55 
+    <script src="fetch.js"></script>
56 
+    <script src="run.js"></script>
57 
+  </body>
51 58 
 </html>
archive-root/run.js
History View file @ 79f9884
... ... 
@@ -1,97 +1,130 @@
1 1 
 root = new Vue({
2 
-  el: '#container',
3 
-  data: {
4 
-    "pull_time": null,
5 
-    "feed_urls": [],
6 
-    feeds: {
7 
-      feeds: []
8 
-    },
2 
+    el: '#container',
3 
+    data: {
4 
+	"pull_time": null,
5 
+	"feed_urls": [],
6 
+	feeds: {
7 
+	    feeds: []
8 
+	},
9 9
10 
-    current_feed: {
11 
-      title: null,
12 
-      fetch_url: null,
13 
-      link: null,
14 
-      description: null,
15 
-      items: [],
16 
-      base_path: null,
17 
-    },
10 
+	current_feed: {
11 
+	    metadata: {
12 
+		description: null,
13 
+		fetch_url: null,
14 
+		link: null,
15 
+		title: null,
16 
+	    },
17 
+	    base_path: null,
18 
+	    items: [],
19 
+	},
18 20
19 
-    current_item: {
20 
-      title: null,
21 
-      date: null,
22 
-      author: null,
23 
-      id: null,
24 
-      link: null,
25 
-      content: null,
26 
-    },
27 
-  },
21 
+	current_item: {
22 
+	    title: null,
23 
+	    date: null,
24 
+	    author: null,
25 
+	    id: null,
26 
+	    link: null,
27 
+	    content: null,
28 
+	},
28 29
29 
-  computed: {
30 
-    item_content() {
31 
-      if (this.current_item.content !== null) {
32 
-        return DOMPurify.sanitize(this.current_item.content);
33 
-      }
30 
+	feed_item_counts: {},
34 31 
     },
35 
-  },
36 
-
37 
-  methods: {
38 
-    sanitize(html) {
39 
-      return DOMPurify.sanitize(html, {
40 
-        FORBID_TAG: ['style'],
41 
-        FORBID_ATTR: ['style'],
42 
-      });
32 
+
33 
+    computed: {
34 
+	item_content() {
35 
+	    let result = null;
36 
+	    if (this.current_item.content !== null) {
37 
+		result = DOMPurify.sanitize(this.current_item.content);
38 
+	    }
39 
+	    return result;
40 
+	},
43 41 
     },
44 42
45 
-    get_feed: function (path) {
46 
-      window.fetch(path+'index.json').then((resp) => resp.json())
47 
-      .then((data) => {
48 
-        var result = Object.assign({}, data);
49 
-        result.fetch_url = data['fetch-url'];
50 
-        result.base_path = path;
51 
-        window.history.pushState({
52 
-          'current_feed': result
53 
-        }, "", window.location.pathname);
54 
-        Object.assign(root.current_feed, result);
55 
-      });
43 
+    methods: {
44 
+	sanitize(html) {
45 
+	    return DOMPurify.sanitize(html, {
46 
+		FORBID_TAG: ['style'],
47 
+		FORBID_ATTR: ['style'],
48 
+	    });
49 
+	},
50 
+
51 
+	get_remote_feed: function (path) {
52 
+	    var promise = new Promise((resolve, reject) => {
53 
+		window.fetch(path+'index.json').then((resp) => resp.json())
54 
+		    .then((data) => {
55 
+			var result = Object.assign({}, data);
56 
+			result.fetch_url = data['fetch-url'];
57 
+			result.base_path = path;
58 
+			window.history.pushState({
59 
+			    'current_feed': result
60 
+			}, "", window.location.pathname);
61 
+			resolve(result);
62 
+			return promise;
63 
+		    }, reject.bind(promise));
64 
+	    });
65 
+	    return promise;
66 
+	},
67 
+
68 
+	get_feed: function (path) {
69 
+	    this.get_remote_feed(path)
70 
+		.then((result) =>
71 
+		      Object.assign(root.current_feed, result));
72 
+	},
73 
+
74 
+	get_item(path) {
75 
+	    window.fetch(this.current_feed.base_path + path).then((resp) => resp.json())
76 
+		.then((data) => {
77 
+		    window.history.pushState({
78 
+			'current_feed': root.current_feed,
79 
+			'current_item': data
80 
+		    }, "", window.location.pathname);
81 
+		    Object.assign(this.current_item, data);
82 
+		});
83 
+	},
84 
+
85 
+	has_items(feed) {
86 
+	    var count = this.feed_item_counts[feed.path];
87 
+	    return count === undefined || (count > 0);
88 
+	},
89 
+
56 90 
     },
57 91
58 
-    get_item(path) {
59 
-      window.fetch(this.current_feed.base_path + path).then((resp) => resp.json())
60 
-      .then((data) => {
61 
-        window.history.pushState({
62 
-          'current_feed': root.current_feed,
63 
-          'current_item': data
64 
-        }, "", window.location.pathname);
65 
-        Object.assign(this.current_item, data);
66 
-      });
67 
-    }
92 
+    ready() {
93 
+	window.fetch(baseUrl+'/index.json').then((resp) => resp.json())
94 
+	    .then(function (data) {
95 
+		root.pull_time = data['pull-time'];
96 
+		root.feed_urls = data['feed-urls'];
97 
+		root.feeds = data.feeds;
98 
+		return data;
99 
+	    })
100 
+	    .then((data) => {
101 
+		root.feeds.forEach((feed) => {
102 
+		    // console.log(feed);
103 
+		    this.get_remote_feed(feed.path)
104 
+			.then((feed_index) => Vue.set(this.feed_item_counts, feed.path, feed_index.items.length));
105 
+		});
106 
+	    });
68 107
69 
-  }
70 
-});
108 
+    },
71 109
72 
-window.fetch(baseUrl+'/index.json').then((resp) => resp.json())
73 
-.then(function (data) {
74 
-  root.pull_time = data['pull-time'];
75 
-  root.feed_urls = data['feed-urls'];
76 
-  root.feeds = data.feeds;
77 110 
 });
78 111
79 112 
 window.onpopstate = function (ev) {
80 
-  console.log(ev);
81 
-  var current_feed = ev.state.current_feed, current_item = ev.state.current_item;
113 
+    // console.log(ev);
114 
+    var current_feed = ev.state.current_feed, current_item = ev.state.current_item;
82 115
83 
-  Object.assign(root.current_feed, current_feed);
116 
+    Object.assign(root.current_feed, current_feed);
84 117
85 
-  if (current_item !== undefined) {
86 
-    Object.assign(root.current_item, current_item);
87 
-  }
118 
+    if (current_item !== undefined) {
119 
+	Object.assign(root.current_item, current_item);
120 
+    }
88 121 
 };
89 122
90 123 
 document.addEventListener('DOMContentLoaded', function (ev) {
91 
-  if (window.history.state !== null) {
92 
-    Object.assign(root.current_feed, window.history.state.current_feed);
93 
-    if (window.history.state.current_item !== undefined) {
94 
-      Object.assign(root.current_item, window.history.state.current_item);
124 
+    if (window.history.state !== null) {
125 
+	Object.assign(root.current_feed, window.history.state.current_feed);
126 
+	if (window.history.state.current_item !== undefined) {
127 
+	    Object.assign(root.current_item, window.history.state.current_item);
128 
+	}
95 129 
     }
96 
-  }
97 130 
 });
archive-root/style.css
History View file @ 79f9884
... ... 
@@ -1,3 +1,7 @@
1 
+* {
2 
+    box-sizing: border-box;
3 
+}
4 
+
1 5 
 body {
2 6 
   margin: 0px;
3 7 
   font-family: 'Lato', 'Alegreya Sans', sans-serif;
... ... 
@@ -17,20 +21,34 @@ body {
17 21
18 22 
 a {
19 23 
   color: #28b0b1;
24 
+  border: thin solid transparent;
25 
+}
26 
+
27 
+.current_feed a, .feeds a {
28 
+  display: inline-block;
29 
+  vertical-align: middle;
30 
+  text-decoration: none;
31 
+  cursor: pointer;
32 
+  /*width: 100%;*/
33 
+  margin-right: 1em;
20 34 
   /*text-shadow: 0em 0em 0.1em #000*/
21 35 
   /*,            0em 0em 0.2em #888;*/
22 36 
 }
23 37
24 
-a:hover, a:focus {
38 
+a:hover {
39 
+  border-color: #28b0b1;
40 
+}
41 
+
42 
+a:focus {
25 43 
   text-decoration: underline;
26 44 
 }
27 45
28 
-.left, .right {
46 
+.right {
29 47 
   overflow-y: auto;
30 48 
 }
31 49
32 50 
 .right {
33 
-  width: 66vw;
51 
+  width: 50vw;
34 52 
   height: 100vh;
35 53 
   box-sizing: border-box;
36 54 
   position: absolute;
... ... 
@@ -48,11 +66,12 @@ h1, h2, h3, h4, h5, h6 {
48 66
49 67 
 .left {
50 68 
   border-right: 4px #28b0b1 double;
51 
-  width: 33vw;
69 
+  box-shadow: 0px 0px 1em #28b0b1;
70 
+  width: 50vw;
52 71 
   height: 100vh;
72 
+  overflow: hidden;
53 73 
   box-sizing: border-box;
54 74 
   position: absolute;
55 
-  padding: 1em;
56 75 
   display: block;
57 76 
   left: 0;
58 77 
 }
... ... 
@@ -63,3 +82,37 @@ h1, h2, h3, h4, h5, h6 {
63 82 
   display: block;
64 83 
   margin: auto;
65 84 
 }
85 
+
86 
+.current_feed, .feeds {
87 
+    overflow-x: hidden;
88 
+    overflow-y: scroll;
89 
+}
90 
+
91 
+.current_feed {
92 
+    height: 100vh;
93 
+    width: 25vw;
94 
+    float: right;
95 
+}
96 
+
97 
+.feeds {
98 
+    height: 100vh;
99 
+    width: 24vw;
100 
+    float: left;
101 
+    padding: 1em;
102 
+    border-bottom: 5px #28b0b1 double;
103 
+    box-shadow: 0px 0px 1em #28b0b1;
104 
+}
105 
+
106 
+.feeds .title, .feeds .url {
107 
+    white-space: nowrap;
108 
+}
109 
+
110 
+.feeds .title {
111 
+    font-size: 120%;
112 
+}
113 
+
114 
+.feeds .url {
115 
+    font-size: 75%;
116 
+    padding-left: 2.5em;
117 
+    margin-bottom: 0.5em;
118 
+}
deploy.lisp
History View file @ 79f9884
66 119 
new file mode 100644
... ... 
@@ -0,0 +1,4 @@
1 
+(load (truename "~/quicklisp/setup.lisp"))
2 
+(push "/home/edwlan/github_repos/alimenta-feed-archive/" asdf:*central-registry*)
3 
+(ql:quickload :alimenta-feed-archive)
4 
+(save-lisp-and-die "feed-archiver" :executable t :toplevel #'alimenta.feed-archive::command-line-main)
feed-archive.lisp
History View file @ 79f9884
... ... 
@@ -1,5 +1,6 @@
1 1 
 (defpackage :alimenta.feed-archive
2 
-  (:use :cl :alexandria :serapeum :fw.lu))
2 
+  (:use :cl :alexandria :serapeum :fw.lu :alimenta.feed-archive.tools)
3 
+  (:shadowing-import-from :alimenta.feed-archive.tools :->))
3 4
4 5 
 (in-package :alimenta.feed-archive)
5 6
... ... 
@@ -9,97 +10,59 @@
9 10 
 (defparameter +dirname-format+
10 11 
   '((:year 4) #\- (:month 2) #\- (:day 2) #\/ (:hour 2) #\- (:min 2) #\/))
11 12
12 
-(defmethod yason:encode ((object pathname) &optional stream)
13 
-  (yason:encode (princ-to-string (uiop:native-namestring object))
14 
-		       stream)
15 
-  object)
16 
-
17 
-(defmethod yason:encode ((object puri:uri) &optional stream)
18 
-  (yason:encode (puri:render-uri object nil)
19 
-		stream)
20 
-  object)
21 
-
22 
-(defun sha256-string (string)
23 
-  (let* ((digester (ironclad:make-digesting-stream :sha256))
24 
-	 (digest-stream (flexi-streams:make-flexi-stream digester)))
25 
-    (princ string digest-stream)
26 
-    (crypto:byte-array-to-hex-string
27 
-     (crypto:produce-digest
28 
-      digester))))
29 
-
30 13 
 (defun get-store-directory-name (timestamp)
31 
-  (car
32 
-    (prog1-let ((result (merge-pathnames
33 
-                          (local-time:format-timestring
34 
-                            nil
35 
-                            (local-time:timestamp-minimize-part timestamp :sec)
36 
-                            :format +dirname-format+)
37 
-                          *feed-base*)))
38 
-      (ensure-directories-exist result))))
39 
-
40 
-(defun fix-pathname ()
41 
-  (let ((restart (find-restart 'fix-pathname)))
42 
-    (when restart
43 
-      (invoke-restart restart))))
14 
+  (flet ((make-dirname (timestamp)
15 
+	   (merge-pathnames (local-time:format-timestring nil (local-time:timestamp-minimize-part timestamp :sec)
16 
+							  :format +dirname-format+)
17 
+			    *feed-base*)))
18 
+    (-> (prog1-let ((result (make-dirname timestamp)))
19 
+	  (ensure-directories-exist result))
20 
+	(car))))
21 
+
22 
+(defun %encode-item (root-dir item)
23 
+  (let ((restarted nil))
24 
+    (destructuring-bind (title path) item
25 
+      (tagbody start
26 
+	 (format t "~&Restarted: ~a" restarted)
27 
+	 (when restarted
28 
+	   (format t " ~a~%"(namestring path)))
29 
+	 (restart-case
30 
+	     (progn (format t "~&encoding . . .~%")
31 
+		    (let ((pathname (uiop:enough-pathname path root-dir)))
32 
+		      (yason:with-object ()
33 
+			(yason:encode-object-element "title" title)
34 
+			(yason:encode-object-element "path" pathname))))
35 
+	   (fix-pathname ()
36 
+	     (setf path
37 
+		   (merge-pathnames path
38 
+				    (make-pathname :type :unspecific)))
39 
+	     (unless restarted
40 
+	       (setf restarted t)
41 
+	       (go start))))))))
44 42
45 43 
 (defun encode-feed-as-json (feed item-storage-info root-dir &optional stream)
46 
-  (declare (optimize (debug 3)))
47 
-  (flet ((encode-item (item)
48 
-	   (let ((restarted nil))
49 
-	     (destructuring-bind (title path) item
50 
-	       (tagbody start
51 
-		  (format t "~&Restarted: ~a" restarted)
52 
-		  (when restarted
53 
-		    (format t " ~a~%"(namestring path)))
54 
-		  (restart-case
55 
-		      (progn (format t "~&encoding . . .~%")
56 
-			     (let ((pathname (uiop:enough-pathname path root-dir)))
57 
-			       (yason:with-object ()
58 
-				 (yason:encode-object-element "title" title)
59 
-				 (yason:encode-object-element "path" pathname))))
60 
-		    (fix-pathname ()
61 
-		      (setf path
62 
-			    (merge-pathnames path
63 
-					     (make-pathname :type :unspecific)))
64 
-		      (unless restarted
65 
-			(setf restarted t)
66 
-			(go start)))))))))
67 
-    (with-accessors ((description alimenta:description)
68 
-		     (feed-link alimenta:feed-link)
69 
-		     (items alimenta:items)
70 
-		     (link alimenta:link)
71 
-		     (source-type alimenta:source-type)
72 
-		     (title alimenta:title)) feed
73 
-      (yason:with-output (stream :indent t)
74 
-	(yason:with-object ()
75 
-	  (yason:encode-object-element "title" title)
76 
-	  (yason:encode-object-element "fetch-url"
77 
-				       (puri:render-uri feed-link nil))
78 
-	  (yason:encode-object-element "link" link)
79 
-					;(yason:encode-object-element "source-type" source-type)
80 
-	  (yason:encode-object-element "description" description)
81 
-	  (yason:with-object-element ("items")
82 
-	    (yason:with-array ()
83 
-	      (dolist (item item-storage-info)
84 
-		(with-simple-restart (continue "Skip item ~s" (car item))
85 
-		  (encode-item item))))))))))
86 
-
87 
-(defun older-than-a-week (date)
88 
-  (let ((week-ago (local-time:timestamp- (local-time:now)
89 
-                                         7 :day)))
90 
-    (local-time:timestamp< date week-ago)))
91 
-
92 
-(defmethod get-id ((feed alimenta:feed))
93 
-  (let* ((link (alimenta:feed-link feed))
94 
-	 (host (puri:uri-host link)))
95 
-    (concat host "-" (sha256-string link) "/")))
96 
-
97 
-(defun get-feed-store-name (feed directory)
98 
-  (merge-pathnames (get-id feed)
99 
-                   directory))
44 
+  (with-accessors ((description alimenta:description)
45 
+		   (feed-link alimenta:feed-link)
46 
+		   (items alimenta:items)
47 
+		   (link alimenta:link)
48 
+		   (source-type alimenta:source-type)
49 
+		   (title alimenta:title)) feed)
50 
+  (yason:with-output (stream :indent t)
51 
+    (yason:with-object ()
52 
+      (yason:encode-object-element "metadata" feed)
53 
+      (yason:with-object-element ("items")
54 
+	(yason:with-array ()
55 
+	  (dolist (item item-storage-info)
56 
+	    (with-simple-restart (continue "Skip item ~s" (car item))
57 
+	      (%encode-item root-dir item))))))))
58 
+
59 
+(defmethod store ((item alimenta:item) directory)
60 
+  (prog1-let ((item-title (alimenta:title item))
61 
+	      (fn (get-item-store-name item directory)))
62 
+    (with-open-file (item-f fn :direction :output)
63 
+      (yason:encode item item-f))))
100 64
101 65 
 (defmethod store ((feed alimenta:feed) directory)
102 
-  (declare (optimize (debug 3)))
103 66 
   (with-accessors ((description alimenta:description)
104 67 
 		   (feed-link alimenta:feed-link)
105 68 
 		   (items alimenta:items)
... ... 
@@ -116,7 +79,6 @@
116 79 
 			     index)))))
117 80
118 81 
 (defmethod store ((items sequence) directory)
119 
-  (declare (optimize (debug 3)))
120 82 
   (map 'list (lambda (item) (store item directory))
121 83 
        (stable-sort
122 84 
          (sort (remove-if #'older-than-a-week items :key #'alimenta:date)
... ... 
@@ -125,17 +87,6 @@
125 87 
          #'local-time:timestamp>
126 88 
          :key #'alimenta:date)))
127 89
128 
-(defmethod get-id ((item alimenta:item))
129 
-  (concatenate 'string
130 
-	       (local-time:format-timestring nil (alimenta:date item))
131 
-	       "-"
132 
-	       (sha256-string (alimenta:id item))
133 
-	       ".json"))
134 
-
135 
-(defun get-item-store-name (item directory)
136 
-  (let ((id (get-id item)))
137 
-    (merge-pathnames (make-pathname :name id) directory)))
138 
-
139 90 
 (defmethod yason:encode ((item alimenta:item) &optional stream)
140 91 
   (with-accessors ((author alimenta::author)
141 92 
                    (content alimenta:content)
... ... 
@@ -154,13 +105,12 @@
154 105 
 	  (yason:encode-object-element "content" content)))))
155 106 
   item)
156 107
157 
-(defmethod store ((item alimenta:item) directory)
158 
-  (declare (optimize (debug 3)))
159 
-  (prog1-let ((item-title (alimenta:title item))
160 
-	      (fn (get-item-store-name item directory)))
161 
-    (with-open-file (item-f fn :direction :output)
162 
-      (yason:encode item item-f))))
163 108
109 
+(defun test-feed-list ()
110 
+  (values '("http://feeds.feedburner.com/GamasutraFeatureArticles/"
111 
+	    "http://feeds.feedburner.com/GamasutraNews/"
112 
+	    "http://feeds.feedburner.com/GamasutraColumns/")
113 
+	  #p"/tmp/feed-archive/"))
164 114
165 115 
 (defun init-feeds (&key feed-list archive-root)
166 116 
   (ubiquitous:restore 'alimenta.feed-archiver)
... ... 
@@ -171,14 +121,12 @@
171 121 
             (ubiquitous:defaulted-value default-root :archive :root))))
172 122
173 123 
 (defun add-feed (feed)
174 
-  (declare (optimize (debug 3)))
175 124 
   (init-feeds)
176 125 
   (pushnew feed
177 126 
            (ubiquitous:value :feeds)
178 127 
            :test #'equalp))
179 128
180 129 
 (defun safe-pull-feed (feed-url)
181 
-  (declare (optimize (debug 3)))
182 130 
   (let ((pop-times 0))
183 131 
     (handler-bind
184 132 
       ((condition
... ... 
@@ -196,42 +144,43 @@
196 144 
         (decf pop-times)))))
197 145
198 146 
 (defun archive-feeds ()
199 
-  (declare (optimize (debug 3)))
200 
-  (multiple-value-bind (*feeds* *feed-base*) (init-feeds)
201 
-    (let ((pull-time (local-time:now)))
202 
-      (alimenta.pull-feed::with-user-agent ("Feed Archiver v0.1b")
203 
-        (let* ((pull-directory (get-store-directory-name pull-time))
204 
-               (paths (loop for feed-url in *feeds* collect
205 
-                            (with-simple-restart (continue "Skip ~a" feed-url)
206 
-                              (let ((feed (safe-pull-feed feed-url)))
207 
-                                (setf (alimenta:feed-link feed)
208 
-                                      feed-url)
209 
-                                (store feed pull-directory))))))
210 
-          (with-open-file (index (merge-pathnames "index.json" pull-directory) :direction :output)
211 
-            (yason:with-output (index :indent t)
212 
-              (yason:with-object ()
213 
-                (yason:encode-object-element "pull-time" (local-time:format-timestring nil pull-time))
214 
-                (yason:encode-object-element "feed-urls" *feeds*)
215 
-                (yason:with-object-element ("feeds")
216 
-                  (yason:with-array ()
217 
-                    (mapcar (lambda (url feed-data)
218 
-                              (yason:with-object ()
219 
-                                (yason:encode-object-element "url" url)
220 
-				(when feed-data
221 
-				  (destructuring-bind (title path) feed-data
222 
-				    (yason:encode-object-element "title" title)
223 
-				    (yason:encode-object-element "path"
224 
-								 (princ-to-string
225 
-								  (uiop:enough-pathname path *feed-base*)))))))
226 
-			    *feeds*
227 
-			    paths)))))))))))
228 
-
229 
-
230 
-(defun command-line-main ()
231 
-  (handler-bind ((t (lambda (c)
147 
+  (let ((pull-time (local-time:now)))
148 
+    (alimenta.pull-feed::with-user-agent ("Feed Archiver v0.1b")
149 
+      (let* ((pull-directory (get-store-directory-name pull-time))
150 
+	     (paths (loop for feed-url in *feeds* collect
151 
+			 (with-simple-restart (continue "Skip ~a" feed-url)
152 
+			   (let ((feed (safe-pull-feed feed-url)))
153 
+			     (setf (alimenta:feed-link feed)
154 
+				   feed-url)
155 
+			     (store feed pull-directory))))))
156 
+	(with-open-file (index (merge-pathnames "index.json" pull-directory) :direction :output)
157 
+	  (yason:with-output (index :indent t)
158 
+	    (yason:with-object ()
159 
+	      (yason:encode-object-element "pull-time" (local-time:format-timestring nil pull-time))
160 
+	      (yason:encode-object-element "feed-urls" *feeds*)
161 
+	      (yason:with-object-element ("feeds")
162 
+		(yason:with-array ()
163 
+		  (mapcar (lambda (url feed-data)
164 
+			    (yason:with-object ()
165 
+			      (yason:encode-object-element "url" url)
166 
+			      (when feed-data
167 
+				(destructuring-bind (title path) feed-data
168 
+				  (yason:encode-object-element "title" title)
169 
+				  (yason:encode-object-element "path"
170 
+							       (princ-to-string
171 
+								(uiop:enough-pathname path *feed-base*)))))))
172 
+			  *feeds*
173 
+			  paths))))))))))
174 
+
175 
+
176 
+(defun command-line-main (&optional (feed-list-initializer #'init-feeds))
177 
+  (handler-bind ((error (lambda (c)
232 178 
 		      c
179 
+		      (format t "~&CONDITION RECEIVED: ~S~%RESTARTS: ~s~%" c (compute-restarts c))
233 180 
 		      (if (find-restart 'fix-pathname)
234 181 
 			  (fix-pathname)
235 182 
 			  (progn (format t "~&Skip a feed...~%")
236 183 
 				 (continue))))))
237 
-    (archive-feeds)))
184 
+    (multiple-value-bind (*feeds* *feed-base*) (funcall feed-list-initializer)
185 
+      (archive-feeds))))
186 
+
tools.lisp
History View file @ 79f9884
238 187 
new file mode 100644
... ... 
@@ -0,0 +1,67 @@
1 
+(defpackage :alimenta.feed-archive.tools
2 
+  (:use :cl :alexandria :serapeum :fw.lu)
3 
+  (:shadow :->)
4 
+  (:export :fix-pathname :sha256-string :get-id :older-than-a-week :-> :get-feed-store-name
5 
+	   :store :get-item-store-name))
6 
+
7 
+(in-package :alimenta.feed-archive.tools)
8 
+
9 
+(defgeneric store (item directory)
10 
+  (:documentation "Store an item in a directory"))
11 
+
12 
+(defmacro -> (&rest forms)
13 
+  (let ((forms (mapcar (lambda (form)
14 
+			 (typecase form
15 
+			   (list form)
16 
+			   (t (list form))))
17 
+		       forms)))
18 
+    (loop with result = (car forms)
19 
+       for form in (cdr forms)
20 
+       do
21 
+	 (setf result `(,(car form)
22 
+			 ,result
23 
+			 ,@(cdr form)))
24 
+       finally
25 
+	 (return result))))
26 
+
27 
+(defun fix-pathname ()
28 
+  (let ((restart (find-restart 'fix-pathname)))
29 
+    (when restart
30 
+      (invoke-restart restart))))
31 
+
32 
+(defun sha256-string (string)
33 
+  (let* ((digester (ironclad:make-digesting-stream :sha256))
34 
+	 (digest-stream (flexi-streams:make-flexi-stream digester)))
35 
+    (princ string digest-stream)
36 
+    (crypto:byte-array-to-hex-string
37 
+     (crypto:produce-digest
38 
+      digester))))
39 
+
40 
+(defgeneric get-id (feed)
41 
+  (:documentation "Get an identifier for a feed"))
42 
+
43 
+(defmethod get-id ((feed alimenta:feed))
44 
+  (let* ((link (alimenta:feed-link feed))
45 
+	 (host (puri:uri-host link)))
46 
+    (concat host "-" (sha256-string link) "/")))
47 
+
48 
+(defmethod get-id ((item alimenta:item))
49 
+  (concatenate 'string
50 
+	       (local-time:format-timestring nil (alimenta:date item))
51 
+	       "-"
52 
+	       (sha256-string (alimenta:id item))
53 
+	       ".json"))
54 
+
55 
+(defun get-item-store-name (item directory)
56 
+  (let ((id (get-id item)))
57 
+    (merge-pathnames (make-pathname :name id) directory)))
58 
+
59 
+(defun get-feed-store-name (feed directory)
60 
+  (merge-pathnames (get-id feed)
61 
+                   directory))
62 
+
63 
+(defun older-than-a-week (date)
64 
+  (let ((week-ago (local-time:timestamp- (local-time:now)
65 
+                                         7 :day)))
66 
+    (local-time:timestamp< date week-ago)))
67 
+
yason-encoders.lisp
History View file @ 79f9884
0 68 
new file mode 100644
... ... 
@@ -0,0 +1,30 @@
1 
+(defmethod yason:encode ((object pathname) &optional stream)
2 
+  (yason:encode (princ-to-string (uiop:native-namestring object))
3 
+		       stream)
4 
+  object)
5 
+
6 
+(defmethod yason:encode ((object puri:uri) &optional stream)
7 
+  (yason:encode (puri:render-uri object nil)
8 
+		stream)
9 
+  object)
10 
+
11 
+(defmethod yason:encode-slots progn ((feed alimenta:feed))
12 
+  (with-accessors ((description alimenta:description)
13 
+		   (feed-link alimenta:feed-link)
14 
+		   (items alimenta:items)
15 
+		   (link alimenta:link)
16 
+		   (source-type alimenta:source-type)
17 
+		   (title alimenta:title)) feed
18 
+    (yason:encode-object-element "title" title)
19 
+    (yason:encode-object-element "fetch-url"
20 
+				 (puri:render-uri feed-link nil))
21 
+    (yason:encode-object-element "link" link)
22 
+    ;;(yason:encode-object-element "source-type" source-type)
23 
+    (yason:encode-object-element "description" description))
24 
+  feed)
25 
+
26 
+
27 
+(defmethod yason:encode ((feed alimenta:feed) &optional stream)
28 
+  (yason:with-output (stream :indent t)
29 
+    (yason:encode-object feed)))
30 
+