(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))))))