blob: a1ed7e91643e54708c88a31e73ce961a134c4f09 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
(in-package :phaser.tracker)
(defvar *max-num* 100)
(defvar *max-age* (* 14 24 3600)) ; Two weeks
(defvar *tracking-key-fmt* "HISTORY-~a")
(defvar *index-key* "STATUSES")
(defun tracking-key-status-id (key)
(subseq key (length (format nil *tracking-key-fmt* ""))))
(defun status-data-key (status)
(format nil "status-~a" (tooter:id status)))
(defstruct status-tracker
time id)
(defun status-tracker-to-cons (tracker)
(cons (status-tracker-time tracker)
(status-tracker-id tracker)))
(defun status-tracker-from-cons (pair)
(make-status-tracker :time (car pair)
:id (cdr pair)))
(defun status-tracker-from-status (status)
(make-status-tracker :time (tooter:created-at status)
:id (tooter:id status)))
(defun read-from-redis (key)
(let ((data (red:get key)))
(when data
(read-from-string data))))
(defun read-list-from-redis (key)
(let ((data (red:lrange key 0 -1)))
(mapcar #'read-from-string data)))
(defun load-status-trackers ()
(mapcar #'status-tracker-from-cons
(read-from-redis *index-key*)))
(defun save-status-trakers (trackers)
(let ((data (mapcar #'status-tracker-to-cons trackers)))
(red:set *index-key* data)
trackers))
(defun rand-pick (sequence)
"Picks a random number of items from sequence"
(subseq sequence 0 (random (length sequence))))
(defun strip-tracked-statuses (tracked-statuses new-statuses)
(remove-if
(lambda (status)
(find (tooter:id status)
tracked-statuses
:test (lambda (id tracker)
(eql id (status-tracker-id tracker)))))
new-statuses))
(defun get-new-statuses (tracked-statuses)
(let* ((statuses (get-timeline))
(num-statuses-to-pick (- *max-num* (length tracked-statuses)))
(new-statuses (rand-pick
(strip-tracked-statuses tracked-statuses statuses))))
(if (> (length new-statuses) num-statuses-to-pick)
(subseq new-statuses 0 num-statuses-to-pick)
new-statuses)))
(defun track-status (tracker)
(let ((status (get-status (status-tracker-id tracker))))
(red:lpush (format nil *tracking-key-fmt* (tooter:id status))
(list
(cons 'time (get-universal-time))
(cons 'age (- (get-universal-time) (tooter:created-at status)))
(cons 'favourites (tooter:favourites-count status))
(cons 'replies (tooter:replies-count status))
(cons 'reblogs (tooter:reblogs-count status))))))
(defun track-statuses ()
(redis:with-connection ()
(let ((tracked-statuses (load-status-trackers)))
;; Fill up the tracked status pool
(when (< (length tracked-statuses) *max-num*)
(setf tracked-statuses (nconc
tracked-statuses
(mapcar
#'status-tracker-from-status
(get-new-statuses tracked-statuses)))))
;; for each status, request details
(mapc #'track-status tracked-statuses)
;; if status is older than max-age, remove from list of tracked statuses
(setf tracked-statuses (remove-if
(lambda (tracker)
(< (status-tracker-time tracker)
(- (get-universal-time) *max-age*)))
tracked-statuses))
;; Persist tracking list
(save-status-trakers tracked-statuses))))
(defun collect-status-tracking (id)
(read-list-from-redis (format nil *tracking-key-fmt* id)))
(defun collect-tracking (&key print)
(redis:with-connection ()
(let* ((history-keys (red:keys (format nil *tracking-key-fmt* "*")))
(status-history (mapcar (lambda (history-key)
(let ((id (tracking-key-status-id history-key)))
(cons
id
(collect-status-tracking id))))
history-keys)))
;; status-history
(format print "~{~a~%~}"
(alexandria:flatten
(mapcar (lambda (item)
(mapcar
(lambda (entry)
(format nil "~a,~a,~a,~a,~a,~a"
(car item)
(cdr (assoc 'time entry))
(cdr (assoc 'favourites entry))
(cdr (assoc 'reblogs entry))
(cdr (assoc 'replies entry))
(when (assoc 'age entry)
(cdr (assoc 'age entry)))))
(cdr item)))
status-history))))))
|
