(defun ts->ms (ts) (+ (* 1000 (local-time:timestamp-to-unix ts)) (floor (local-time:nsec-of ts) 1000000))) (defun ms->ts (ms) (multiple-value-bind (unix msec) (floor ms 1000) (local-time:unix-to-timestamp unix :nsec (* msec 1000000)))) (defun doc->point (doc) (geo:point-deg (/ (get-element "latitudeE7" doc) 1d7) (/ (get-element "longitudeE7" doc) 1d7))) (defun doc->ts (doc) (local-time:unix-to-timestamp (floor (get-element "timestampMs" doc) 1000))) (defun day-kv (date) (ts->kv (local-time:parse-timestring date))) (defun $between (a from to) (kv ($>= a from) ($< a to))) (defun ts->kv (ts) (let ((nd (local-time:timestamp+ ts 1 :day))) ($between "timestampMs" (* 1000 (local-time:timestamp-to-unix ts)) (* 1000 (local-time:timestamp-to-unix nd))))) (defun reverse-geocode (lat lon) (let* ((data (yason:parse (flexi-streams:octets-to-string (drakma:http-request (format nil "http://open.mapquestapi.com/nominatim/v1/reverse.php?format=json&lat=~A&lon=~A" lat lon))))) (address (gethash "address" data))) (values (gethash "display_name" data) address))) (defun make-place-doc (ts point) (let ((lat (geo:latitude-deg point)) (lon (geo:longitude-deg point))) (multiple-value-bind (text address) (reverse-geocode lat lon) (kv (kv :ts (ts->ms ts)) (kv :type "place") (kv :title text) (kv :language (gethash "country_code" address)) (kv :loc (kv (kv :type "Point") ; GeoJSON Point (kv :coordinates (list lon lat)))))))) (defun extract-places (docs) (loop for doc in docs for point = (doc->point doc) with last-place and moved and need-add when last-place do (setf moved (geo:distance>= (geo:distance-between point (doc->point last-place)) (geo:distance-meters 200))) when moved do (setf last-place doc need-add t) when (and need-add (> (local-time:timestamp-difference (doc->ts doc) (doc->ts last-place)) 400)) collect (cons (doc->ts last-place) (doc->point last-place)) and do (setf need-add nil) when (not last-place) do (setf last-place doc))) (defun takedown-import (from-date) (let ((now (local-time:now))) (loop for ts = (local-time:parse-timestring from-date) then (local-time:timestamp+ ts 1 :day) for locs = (docs (db.sort "locations" (ts->kv ts) :field "timestampMs" :limit 1440)) for places = (extract-places locs) when places do (format t "Inserting ~A places for ~A~%" (length places) ts) (loop for place in places do (db.insert "events" (make-place-doc (car place) (cdr place)))) until (local-time:timestamp> ts now) finally (return ts)))) (defvar *google-cookie* "HSID=Aki-sRjrdW5Ikzy3v; SSID=Anhcow9ItEBTeSEg7; APISID=-70vjTcatbI3TD06/AwZG1FFCCDcT4k9fE; SAPISID=dZqsEdkN1kgwG5XK/AHKoDsreJPB4Vw_Ua; NID=67=iUAiGWHq9qJ29H3u0bbOwMDP4jQ8Ef3bL6w9u_eKXRwhTlVyyjsIIWQ11OgszFDjNrdSK_ibUXJot6keGMAqDetXyRTnTyQlR5E0a0DoTbOrul4bX7WEvBr-A24va66oFrMCQYwjSVgR4BK2Q5A1tVcw5tX_iFOH3HfwRZFXzUG6IHHI-96X1XPRoK0TH4D9LVBESdlf-XZLJ8yPv2s7b7NVVgFM1rYwsSbyvA-ps0CTC0DrCDL4L6MOixw0PtuWPsCE7F4-LFzAWAb-7yVhLpLJ; SID=DQAAALEBAAAQi6d7KrAJlOV7d9a8PsJSV0PmImGKfIQ-SUbWmiN8oyGMDYdPdM7Og6dF6VE45MMhzJ5Ckwselasme4hxuTOHqYJfPr7oCj8rz_71TIn1WO-GAkG3nYSh_6wvsG4L2ediBbHJB0LYRMfxYMynr5WEjHm1xDiRGyeIKnY3aZTp6h6rFFPg4ansPuPrig9cSBPpA0vLW5mUko9adS_NpWN8BAY9AQK01GyPq_QV1fDp-hTXwXTFNrYupU576r9-47xDzuG9GPecsihi8WBeFMwyvQBGixmlmxT8eFO6oh4p6Ocp_Ed3OVN-HLeZ0zO0oJSWR8rG_mUAmX9sAG80dEtGMvXvYPnza86nsQNgMyK82GQSHW083W3zxoDE3RoTb6sZh49J8TKPBRzMWL7d7CnUxahmUf-Ro06LLAt6rOOpw5JJzBLZr3UzvKzJWV-2WzEyJlNwmD8fkVFL5qyYBsihhdxWYENR3l3TRjQ5vzLB9QyoBgyka56oVreDAgtnQYB7M8CpY1TnBb_jHJbKSL9nAJYpW8xAwfte5PTb7px5K1rGj9JwSvwYhYwbfJIHh1N4ClwkdLlHBiTvVHkW9QDx") (defvar *google-manual-header* "EI9X7MP_UN6KaVDOoQ4mMn91XdQ:1400594464924") (defun load-history (from to &key (trim nil)) (loop for loc in (cadadr (yason:parse (flexi-streams:octets-to-string (drakma:http-request "https://maps.google.com/locationhistory/b/1/apps/pvjson?t=0" :method :post :content (format nil "[null,~A,~A,~A]" (ts->ms from) (ts->ms to) (if trim "true" "false")) :additional-headers (list (cons "x-manualheader" *google-manual-header*) (cons "cookie" *google-cookie*)))))) collect (list (ms->ts (parse-integer (cadr loc))) (cons (caddr loc) (cadddr loc)))))