(in-package #:chatikbot) (defvar *db-name* "db.sqlite" "SQLite database name") (defun db-path () (merge-pathnames *db-name* (asdf:component-pathname (asdf:find-system '#:chatikbot)))) (defmacro with-db ((db) &body body) `(sqlite:with-open-database (,db (db-path) :busy-timeout 30) (sqlite:execute-non-query ,db "PRAGMA foreign_keys = ON") ,@body)) (defun db-init () (with-db (db) ;; Finance (sqlite:execute-non-query db "create table if not exists finance (ts, usd, eur, gbp, brent, btc)") (sqlite:execute-non-query db "create index if not exists fin_ts_ids on finance (ts)") ;; Foursquare (sqlite:execute-non-query db "create table if not exists fsq_chat_users (chat_id, user_id)") (sqlite:execute-non-query db "create index if not exists fsq_chat_users_chat_idx on fsq_chat_users (chat_id)") (sqlite:execute-non-query db "create index if not exists fsq_chat_users_user_idx on fsq_chat_users (user_id)") (sqlite:execute-non-query db "create table if not exists fsq_seen (id, created_at)") (sqlite:execute-non-query db "create index if not exists fsq_seen_idx on fsq_seen (id)") ;; RSS (sqlite:execute-non-query db "create table if not exists rss_feeds (id INTEGER PRIMARY KEY, url, title, next_fetch, period)") (sqlite:execute-non-query db "create unique index if not exists rss_feeds_url_idx on rss_feeds (url)") (sqlite:execute-non-query db "create table if not exists rss_items (id INTEGER PRIMARY KEY, feed_id REFERENCES rss_feeds, guid, link, title, published)") (sqlite:execute-non-query db "create index if not exists rss_items_idx on rss_items (feed_id, guid)") (sqlite:execute-non-query db "create table if not exists rss_chat_feeds (chat_id, feed_id REFERENCES rss_feeds)") (sqlite:execute-non-query db "create index if not exists rss_chat_feeds_chat_idx on rss_chat_feeds (chat_id)") (sqlite:execute-non-query db "create index if not exists rss_chat_feeds_feed_idx on rss_chat_feeds (feed_id)") ;; VK (sqlite:execute-non-query db "create table if not exists vk_walls (domain, last_id, next_fetch, period)") (sqlite:execute-non-query db "create unique index if not exists vk_walls_domain_idx on vk_walls (domain)") (sqlite:execute-non-query db "create table if not exists vk_chat_walls (chat_id, domain)") (sqlite:execute-non-query db "create index if not exists vk_chat_walls_chat_idx on vk_chat_walls (chat_id)") (sqlite:execute-non-query db "create index if not exists vk_chat_walls_domain_idx on vk_chat_walls (domain)"))) ;; Finance (defun db-add-finance (ts usd eur gbp brent btc) (with-db (db) (sqlite:execute-non-query db "insert into finance (ts, usd, eur, gbp, brent, btc) values (?, ?, ?, ?, ?, ?)" ts usd eur gbp brent btc))) (defun db-get-last-finance () (with-db (db) (sqlite:execute-one-row-m-v db "select ts, usd, eur, gbp, brent, btc from finance order by ts desc limit 1"))) (defparameter +db-finance-map+ '(("usd" . "USD/RUB") ("eur" . "EUR/RUB") ("gbp" . "GBP/RUB") ("brent" . "Brent") ("btc" . "BTC/USD"))) (defun db-get-series (after-ts &optional (fields '("usd" "eur" "gbp" "brent")) (avg 60)) (when fields (let ((sql (format nil "select ts/~a*~:*~a,~{avg(~a) as ~:*~a~^,~} from finance where ts >= ? group by ts/~a order by ts" avg fields avg))) (with-db (db) (values (sqlite:execute-to-list db sql (local-time:timestamp-to-unix after-ts)) (sublis +db-finance-map+ fields :test #'equal)))))) ;; Foursquare (defun db-fsq-get-chat-users (chat-id) (flatten (with-db (db) (sqlite:execute-to-list db "select user_id from fsq_chat_users where chat_id = ?" chat-id)))) (defun db-fsq-get-user-chats (user-id) (flatten (with-db (db) (sqlite:execute-to-list db "select chat_id from fsq_chat_users where user_id = ?" user-id)))) (defun db-fsq-set-chat-users (chat-id users) (with-db (db) (sqlite:with-transaction db (sqlite:execute-non-query db "delete from fsq_chat_users where chat_id = ?" chat-id) (dolist (user-id users) (sqlite:execute-non-query db "insert into fsq_chat_users (chat_id, user_id) values (?, ?)" chat-id user-id))))) (defun db-fsq-add-seen (id created-at) (with-db (db) (sqlite:execute-non-query db "insert into fsq_seen (id, created_at) values (?, ?)" id created-at))) (defun db-fsq-has-seen (id) (with-db (db) (sqlite:execute-single db "select id from fsq_seen where id = ? limit 1" id))) (defun db-fsq-last-created () (with-db (db) (sqlite:execute-single db "select created_at from fsq_seen order by created_at desc limit 1"))) ;; RSS (defun %make-feed (row) (when row (make-feed :id (nth 0 row) :url (nth 1 row) :title (nth 2 row) :next-fetch (when (nth 3 row) (local-time:unix-to-timestamp (nth 3 row))) :period (nth 4 row)))) (defun db-rss-get-feed-by-url (url) (with-db (db) (%make-feed (car (sqlite:execute-to-list db "select id, url, title, next_fetch, period from rss_feeds where url = ?" url))))) (defun db-rss-add-feed (feed) (with-slots (url title period) feed (let ((next-fetch (feed-next-fetch-unix feed))) (with-db (db) (sqlite:execute-non-query db "insert into rss_feeds (url, title, next_fetch, period) values (?, ?, ?, ?)" url title next-fetch period) (setf (feed-id feed) (sqlite:last-insert-rowid db)) feed)))) (defun db-rss-update-feed (feed) (with-slots (id title period) feed (let ((next-fetch (feed-next-fetch-unix feed))) (with-db (db) (sqlite:execute-non-query db "update rss_feeds set title = ?, next_fetch = ?, period = ? where id = ?" title next-fetch period id))))) (defun db-rss-get-active-feeds () (with-db (db) (mapcar #'%make-feed (sqlite:execute-to-list db "select id, url, title, next_fetch, period from rss_feeds where exists (select 1 from rss_chat_feeds where feed_id=id)")))) (defun db-rss-get-chat-feeds (chat-id) (with-db (db) (mapcar #'%make-feed (sqlite:execute-to-list db "select id, url, title, next_fetch, period from rss_feeds where id in (select feed_id from rss_chat_feeds where chat_id = ?)" chat-id)))) (defun db-rss-get-feed-chats (feed) (with-slots (id) feed (flatten (with-db (db) (sqlite:execute-to-list db "select chat_id from rss_chat_feeds where feed_id = ?" id))))) (defun db-rss-set-chat-feeds (chat-id feeds) (with-db (db) (sqlite:with-transaction db (sqlite:execute-non-query db "delete from rss_chat_feeds where chat_id = ?" chat-id) (dolist (feed feeds) (with-slots (id) feed (sqlite:execute-non-query db "insert into rss_chat_feeds (chat_id, feed_id) values (?, ?)" chat-id id)))))) (defun db-rss-item-exists (item) (let ((feed-id (feed-id (feed-item-feed item))) (guid (feed-item-guid item))) (with-db (db) (sqlite:execute-single db "select id from rss_items where feed_id = ? and guid = ? limit 1" feed-id guid)))) (defun db-rss-add-item (item) (let ((feed-id (feed-id (feed-item-feed item))) (published (feed-item-published-unix item))) (with-slots (guid link title) item (with-db (db) (sqlite:execute-non-query db "insert into rss_items (feed_id, guid, link, title, published) values (?, ?, ?, ?, ?)" feed-id guid link title published))))) (defun %make-feed-item (feed row) (when row (make-feed-item :feed feed :guid (nth 0 row) :link (nth 1 row) :title (nth 2 row) :published (when (nth 3 row) (local-time:unix-to-timestamp (nth 3 row)))))) (defun db-rss-last-feed-items (feed &optional (limit 10)) (with-slots (id) feed (with-db (db) (mapcar #'(lambda (row) (%make-feed-item feed row)) (sqlite:execute-to-list db "select guid, link, title, published from rss_items where feed_id = ? order by published desc, id desc limit ?" id limit))))) ;; VK (defun db-vk-ensure-domain (domain last-id) (with-db (db) (unless (sqlite:execute-single db "select domain from vk_walls where domain = ?" domain) (sqlite:execute-non-query db "insert into vk_walls (domain, last_id, period) values (?, ?, 300)" domain last-id)))) (defun db-vk-get-domain-chats (domain) (with-db (db) (flatten (sqlite:execute-to-list db "select chat_id from vk_chat_walls where domain = ?" domain)))) (defun db-vk-get-chat-domains (chat-id) (with-db (db) (flatten (sqlite:execute-to-list db "select domain from vk_chat_walls where chat_id = ?" chat-id)))) (defun db-vk-add-chat-domain (chat-id domain) (with-db (db) (sqlite:execute-non-query db "insert into vk_chat_walls (chat_id, domain) values (?, ?)" chat-id domain))) (defun db-vk-remove-chat-domain (chat-id domain) (with-db (db) (sqlite:execute-non-query db "delete from vk_chat_walls where chat_id = ? and domain = ?" chat-id domain))) (defun db-vk-get-active-walls () (with-db (db) (sqlite:execute-to-list db "select domain, last_id, next_fetch, period from vk_walls w where exists (select 1 from vk_chat_walls where domain=w.domain)"))) (defun db-vk-update-wall (domain last-id next-fetch period) (with-db (db) (sqlite:execute-to-list db "update vk_walls set last_id = ?, next_fetch = ?, period = ? where domain = ?" last-id next-fetch period domain)))