Refactor to plugin system

db.lisp

@@ -12,221 +12,37 @@
      (sqlite:execute-non-query ,db "PRAGMA foreign_keys = ON")
      ,@body))
 
-(defun db-execute (sql &rest parameters &key db)
-  (if db
-      (apply #'sqlite:execute-non-query db sql parameters)
-      (with-db (db)
-        (apply #'sqlite:execute-non-query db sql parameters))))
+(defun %db-execute (db sql &rest parameters)
+  (apply #'sqlite:execute-non-query db sql parameters))
+(defun %db-select (db sql &rest parameters)
+  (apply #'sqlite:execute-to-list db sql parameters))
+(defun %db-single (db sql &rest parameters)
+  (apply #'sqlite:execute-single db sql parameters))
 
-(defun db-select (sql &rest parameters &key db)
-  (if db
-      (apply #'sqlite:execute-to-list db sql parameters)
-      (with-db (db)
-        (apply #'sqlite:execute-to-list db sql parameters))))
-
-(defmacro def-db-init ((db) &body body)
-  `(add-hook :db-init #'(lambda (,db)
-                          (handler-case (progn ,@body)
-                            (error (e) (log:error e)))
-                          (values))))
-
-(defun db-init ()
-  (with-db (db)
-    (db-execute "create table if not exists settings (var, val)" :db db)
-    (db-execute "create unique index if not exists settings_var_unique on settings (var)" :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 ()
+(defun db-execute (sql &rest parameters)
   (with-db (db)
-    (sqlite:execute-single db "select created_at from fsq_seen order by created_at desc limit 1")))
+    (apply #'%db-execute db sql parameters)
+    (sqlite:last-insert-rowid db)))
 
-
-;; 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)
+(defun db-select (sql &rest parameters)
   (with-db (db)
-    (flatten (sqlite:execute-to-list db "select domain from vk_chat_walls where chat_id  = ?" chat-id))))
+    (apply #'%db-select db sql parameters)))
 
-(defun db-vk-add-chat-domain (chat-id domain)
+(defun db-single (sql &rest parameters)
   (with-db (db)
-    (sqlite:execute-non-query db "insert into vk_chat_walls (chat_id, domain) values (?, ?)" chat-id domain)))
+    (apply #'%db-single db sql parameters)))
 
-(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)))
+(defmacro db-transaction ((db) &body body)
+  `(with-db (,db)
+     (sqlite:with-transaction ,db ,@body)))
 
-(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)")))
+(defmacro def-db-init ((db) &body body)
+  `(add-hook :db-init #'(lambda (,db)
+                          (handler-case (progn ,@body)
+                            (error (e) (log:error e)))
+                          (values))))
 
-(defun db-vk-update-wall (domain last-id next-fetch period)
+(defun db-init ()
   (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)))
+    (%db-execute db "create table if not exists settings (var, val)")
+    (%db-execute db "create unique index if not exists settings_var_unique on settings (var)")))

finance.lisp

@@ -75,17 +75,45 @@
       (adw-charting:set-axis :y "RUB" :draw-gridlines-p t :label-formatter "~,2F")
       (adw-charting:save-file "chart.png"))))
 
+;; Database
+(def-db-init (db)
+  (%db-execute db "create table if not exists finance (ts, usd, eur, gbp, brent, btc)")
+  (%db-execute db "create index if not exists fin_ts_ids on finance (ts)"))
+
+(defun db/add-finance (ts usd eur gbp brent btc)
+  (db-execute "insert into finance (ts, usd, eur, gbp, brent, btc) values (?, ?, ?, ?, ?, ?)"
+              ts usd eur gbp brent btc))
+
+(defun db/get-last-finance ()
+  (values-list (first (db-select "select ts, usd, eur, gbp, brent, btc from finance order by ts desc limit 1"))))
+
+(defparameter +finance-db-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)))
+      (values
+       (db-select sql (local-time:timestamp-to-unix after-ts))
+       (sublis +finance-db-map+ fields :test #'equal)))))
+
+
 ;; Cron
 (defcron process-rates ()
   (let ((ts (local-time:timestamp-to-unix (local-time:now)))
         (rates (get-rates))
         (brent (get-brent))
         (btc (get-btc-e)))
-    (db-add-finance ts (aget "USD/RUB" rates) (aget "EUR/RUB" rates) (aget "GBP/RUB" rates) brent btc)))
+    (db/add-finance ts (aget "USD/RUB" rates) (aget "EUR/RUB" rates) (aget "GBP/RUB" rates) brent btc)))
 
 ;;; Hooks
 (def-message-cmd-handler handler-rates (:rates)
-  (multiple-value-bind (ts usd eur gbp brent btc) (db-get-last-finance)
+  (multiple-value-bind (ts usd eur gbp brent btc) (db/get-last-finance)
     (bot-send-message chat-id
                       (format nil "Зеленый *~,2F*, гейро *~,2F*, британец *~,2F*, чёрная *~,2F*, btc *~,2F* @ _~A_"
                               usd eur gbp brent btc
@@ -95,7 +123,7 @@
 (def-message-cmd-handler handler-charts (:charts)
   (telegram-send-chat-action chat-id "upload_photo")
   (let* ((args (mapcar 'string-downcase args))
-         (all-fields (mapcar #'car +db-finance-map+))
+         (all-fields (mapcar #'car +finance-db-map+))
          (fields (or (intersection args all-fields :test 'equal) all-fields))
          (day-range (some #'(lambda (a) (aget a +chart-ranges+)) args))
          (number (some #'(lambda (a) (parse-integer a :junk-allowed t)) args))
@@ -105,9 +133,9 @@
                       (:otherwise 1))))
          (after-ts (local-time:timestamp- (local-time:now)
                                           (* avg *chart-points*) :sec))
-         (rates (multiple-value-list (db-get-last-finance)))
+         (rates (multiple-value-list (db/get-last-finance)))
          (chart (apply #'make-chart (multiple-value-list
-                                     (db-get-series after-ts fields avg)))))
+                                     (db/get-series after-ts fields avg)))))
     (telegram-send-photo chat-id chart
                          :caption
                          (format nil "Зеленый ~,2F, гейро ~,2F, британец ~,2F, чёрная ~,2F, btc ~,2F @ ~A"

foursquare.lisp

@@ -59,26 +59,55 @@
                (local-time:unix-to-timestamp (aget "createdAt" checkin))
                :format '(:year "-" (:month 2) "-" (:day 2) " " (:hour 2) ":" (:min 2)))))))
 
+;; Database
+(def-db-init (db)
+  (%db-execute db "create table if not exists fsq_chat_users (chat_id, user_id)")
+  (%db-execute db "create index if not exists fsq_chat_users_chat_idx on fsq_chat_users (chat_id)")
+  (%db-execute db "create index if not exists fsq_chat_users_user_idx on fsq_chat_users (user_id)")
+  (%db-execute db "create table if not exists fsq_seen (id, created_at)")
+  (%db-execute db "create index if not exists fsq_seen_idx on fsq_seen (id)"))
+
+(defun db/fsq-get-chat-users (chat-id)
+  (flatten (db-select "select user_id from fsq_chat_users where chat_id = ?" chat-id)))
+
+(defun db/fsq-get-user-chats (user-id)
+  (flatten (db-select "select chat_id from fsq_chat_users where user_id = ?" user-id)))
+
+(defun db/fsq-set-chat-users (chat-id users)
+  (db-transaction (db)
+    (%db-execute db "delete from fsq_chat_users where chat_id = ?" chat-id)
+    (dolist (user-id users)
+      (%db-execute db "insert into fsq_chat_users (chat_id, user_id) values (?, ?)" chat-id user-id))))
+
+(defun db/fsq-add-seen (id created-at)
+  (db-execute "insert into fsq_seen (id, created_at) values (?, ?)" id created-at))
+
+(defun db/fsq-has-seen (id)
+  (db-single "select id from fsq_seen where id = ? limit 1" id))
+
+(defun db/fsq-last-created ()
+  (db-single "select created_at from fsq_seen order by created_at desc limit 1"))
+
 ;; Cron
 (defcron process-latest-checkins ()
   (let ((checkins (make-hash-table))
-        (ts (princ-to-string (1+ (or (db-fsq-last-created) -1)))))
+        (ts (princ-to-string (1+ (or (db/fsq-last-created) -1)))))
     (dolist (checkin (fsq-fetch-checkins ts))
       (let ((id (aget "id" checkin))
             (created-at (aget "createdAt" checkin))
             (user (aget "id" (aget "user" checkin))))
-        (unless (db-fsq-has-seen id)
-          (dolist (chat-id (db-fsq-get-user-chats user))
+        (unless (db/fsq-has-seen id)
+          (dolist (chat-id (db/fsq-get-user-chats user))
             (push (fsq-format-checkin checkin)
                   (gethash chat-id checkins)))
-          (db-fsq-add-seen id created-at))))
+          (db/fsq-add-seen id created-at))))
     (loop for chat-id being the hash-keys in checkins using (hash-value texts)
        do (log:info "Sending checkins" chat-id texts)
          (telegram-send-message chat-id (format nil "~{~A~^~%~}" texts)))))
 
 ;; Hooks
 (def-message-cmd-handler handle-cmd-post-checkins (:postcheckins)
-  (let ((users (db-fsq-get-chat-users chat-id))
+  (let ((users (db/fsq-get-chat-users chat-id))
         (friends (fsq-fetch-friends)))
     (if (null args)
         (bot-send-message chat-id
@@ -104,10 +133,10 @@
                     (progn
                       (push user users)
                       (bot-send-message chat-id (format nil "Теперь палим ~A" username)))))))
-          (db-fsq-set-chat-users chat-id users)))))
+          (db/fsq-set-chat-users chat-id users)))))
 
 (def-message-cmd-handler handle-cmd-friends (:friends)
-  (let ((users (db-fsq-get-chat-users chat-id))
+  (let ((users (db/fsq-get-chat-users chat-id))
         (friends (fsq-fetch-friends)))
     (bot-send-message chat-id
                       (format
@@ -120,7 +149,7 @@
 
 
 (def-message-cmd-handler handle-cmd-checkins (:checkins)
-  (let ((users (db-fsq-get-chat-users chat-id)))
+  (let ((users (db/fsq-get-chat-users chat-id)))
     (when users
       (bot-send-message chat-id
                         (format nil "~{~A~^~%~}"

rss.lisp

@@ -81,16 +81,16 @@
                     :disable-web-preview 1))
 
 (defun %fetch-new-items (feed)
-  (loop for item in (refresh-feed feed #'db-rss-item-exists)
-     do (db-rss-add-item item)
+  (loop for item in (refresh-feed feed #'db/rss-item-exists)
+     do (db/rss-add-item item)
      collect item))
 
 (defun %get-feed (url)
   (when url
-    (or (db-rss-get-feed-by-url url)
+    (or (db/rss-get-feed-by-url url)
         (alexandria:when-let (feed (build-feed url))
           (log:info "Added feed" feed)
-          (db-rss-add-feed feed)
+          (db/rss-add-feed feed)
           (%fetch-new-items feed)
           feed))))
 
@@ -129,17 +129,99 @@
   (alexandria:when-let (ts (feed-item-published item))
     (local-time:timestamp-to-unix ts)))
 
+;; Databaase
+(def-db-init (db)
+  (%db-execute db "create table if not exists rss_feeds (id INTEGER PRIMARY KEY, url, title, next_fetch, period)")
+  (%db-execute db "create unique index if not exists rss_feeds_url_idx on rss_feeds (url)")
+  (%db-execute db "create table if not exists rss_items (id INTEGER PRIMARY KEY, feed_id REFERENCES rss_feeds, guid, link, title, published)")
+  (%db-execute db "create index if not exists rss_items_idx on rss_items (feed_id, guid)")
+
+  (%db-execute db "create table if not exists rss_chat_feeds (chat_id, feed_id REFERENCES rss_feeds)")
+  (%db-execute db "create index if not exists rss_chat_feeds_chat_idx on rss_chat_feeds (chat_id)")
+  (%db-execute db "create index if not exists rss_chat_feeds_feed_idx on rss_chat_feeds (feed_id)"))
+
+(defun %db/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)
+  (%db/make-feed (car (db-select "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)))
+      (setf (feed-id feed) (db-execute "insert into rss_feeds (url, title, next_fetch, period) values (?, ?, ?, ?)"
+                                       url title next-fetch period))
+      feed)))
+
+(defun db/rss-update-feed (feed)
+  (with-slots (id title period) feed
+    (let ((next-fetch (feed-next-fetch-unix feed)))
+      (db-execute "update rss_feeds set title = ?, next_fetch = ?, period = ? where id = ?"
+                  title next-fetch period id))))
+
+(defun db/rss-get-active-feeds ()
+  (mapcar #'%db/make-feed
+          (db-select "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)
+  (mapcar #'%db/make-feed
+          (db-select "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 (db-select "select chat_id from rss_chat_feeds where feed_id = ?" id))))
+
+(defun db/rss-set-chat-feeds (chat-id feeds)
+  (db-transaction (db)
+    (%db-execute db "delete from rss_chat_feeds where chat_id = ?" chat-id)
+    (dolist (feed feeds)
+      (with-slots (id) feed
+        (%db-execute 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)))
+    (db-single "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
+      (db-execute "insert into rss_items (feed_id, guid, link, title, published) values (?, ?, ?, ?, ?)"
+                  feed-id guid link title published))))
+
+(defun %db/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
+    (mapcar #'(lambda (row) (%db/make-feed-item feed row))
+            (db-select "select guid, link, title, published from rss_items where feed_id = ? order by published desc, id desc limit ?" id limit))))
+
+
 ;; Cron
 (defcron process-feeds ()
-  (dolist (feed (remove-if-not #'need-fetch-p (db-rss-get-active-feeds)))
+  (dolist (feed (remove-if-not #'need-fetch-p (db/rss-get-active-feeds)))
     (log:info "Fetching new items" (feed-url feed))
     (dolist (item (%fetch-new-items feed))
-      (dolist (chat-id (db-rss-get-feed-chats feed))
+      (dolist (chat-id (db/rss-get-feed-chats feed))
         (telegram-send-message chat-id
                                (format-feed-item item)
                                :parse-mode "Markdown"
                                :disable-web-preview 1)))
-    (db-rss-update-feed feed))) ;; Update next fetch and period
+    (db/rss-update-feed feed))) ;; Update next fetch and period
 
 ;; Hooks
 (def-message-cmd-handler handler-cmd-feeds (:feeds)
@@ -152,7 +234,7 @@
    :disable-web-preview 1))
 
 (def-message-cmd-handler handler-cmd-rss (:rss)
-  (let ((feeds (db-rss-get-chat-feeds chat-id)))
+  (let ((feeds (db/rss-get-chat-feeds chat-id)))
     (if (null args)
         (%send-feeds chat-id feeds)
         (progn
@@ -170,16 +252,16 @@
                         (setf feeds (remove existing feeds))
                         (push feed feeds)))))
               (error (e) (log:error "~A" e))))
-          (db-rss-set-chat-feeds chat-id feeds)
-          (%send-feeds chat-id (db-rss-get-chat-feeds chat-id))))))
+          (db/rss-set-chat-feeds chat-id feeds)
+          (%send-feeds chat-id (db/rss-get-chat-feeds chat-id))))))
 
 (def-message-cmd-handler handler-cmd-last-rss (:lastrss)
-  (let ((feeds (db-rss-get-chat-feeds chat-id)))
+  (let ((feeds (db/rss-get-chat-feeds chat-id)))
     (if (null args)
         (%send-feeds chat-id feeds)
         (let* ((idx (1- (parse-integer (car args))))
                (limit (min 20 (if (> (length args) 1) (parse-integer (second args)) 5)))
-               (items (db-rss-last-feed-items (nth idx feeds) limit)))
+               (items (db/rss-last-feed-items (nth idx feeds) limit)))
           (telegram-send-message chat-id
                                  (format nil "~{~A~^~%~%~}"
                                          (mapcar #'format-feed-item items))

vk.lisp

@@ -45,57 +45,6 @@
       (vk-get-user-name id)
       (vk-get-group-name id)))
 
-;; Cron
-(defcron process-walls ()
-  (loop for (domain last-id next-fetch period) in (db-vk-get-active-walls)
-     when (or (null next-fetch)
-              (local-time:timestamp> (local-time:now) (local-time:unix-to-timestamp next-fetch)))
-     do (progn
-          (log:info "Fetching wall" domain)
-          (handler-case
-              (let ((new-posts
-                     (remove last-id (reverse (aget "items" (vk-wall-get :domain domain)))
-                             :test #'>= :key (lambda (p) (aget "id" p))))
-                    name)
-                (setf period (adjust-period period (length new-posts)))
-                (when new-posts
-                  (setf name (vk-get-name domain)))
-                (dolist (post new-posts)
-                  (multiple-value-bind (text disable)
-                      (%format-wall-post domain name post)
-                    (dolist (chat-id (db-vk-get-domain-chats domain))
-                      (ignore-errors
-                        (telegram-send-message chat-id text
-                                               :parse-mode "Markdown"
-                                               :disable-web-preview disable))))
-                  (setf last-id (max last-id (aget "id" post)))))
-            (error (e) (log:error "~A" e)))
-          (db-vk-update-wall domain last-id
-                             (local-time:timestamp-to-unix
-                              (local-time:timestamp+ (local-time:now) period :sec))
-                             period))) ;; Update last-id, next-fetch and period
-  )
-
-;; Hooks
-(defparameter +akb-vk-domain+ "baneks" "VK.com username of 'B-category anekdotes'")
-(defvar *akb-max-posts* 10 "Maximum number of AKB posts to send at once")
-
-(defun format-akb (post)
-  (let* ((id (aget "id" post))
-         (url (format nil "https://vk.com/~A?w=wall~A_~A"
-                      +akb-vk-domain+ (aget "from_id" post) id)))
-    (format nil "~A~%~A" (aget "text" post) url)))
-
-(def-message-cmd-handler handler-akb (:akb)
-  (let ((total-aneks
-         (aget "count" (vk-wall-get :domain +akb-vk-domain+ :count 1 :offset 10000000))))
-    (dolist (post (aget "items" (vk-wall-get :domain +akb-vk-domain+
-                                             :count (min *akb-max-posts*
-                                                         (or (ignore-errors (parse-integer (car args)))
-                                                             1))
-                                             :offset (random total-aneks))))
-      (bot-send-message chat-id (format-akb post) :disable-web-preview 1))))
-
 ;; VK walls
 (defun %send-domains (chat-id domains)
   (bot-send-message
@@ -115,7 +64,7 @@
 (defun %ensure-domain (domain)
   (let* ((res (vk-wall-get :domain domain :count 1))
          (last-id (aget "id" (first (aget "items" res)))))
-    (db-vk-ensure-domain domain last-id)
+    (db/vk-ensure-domain domain last-id)
     domain))
 
 (defun %vk-find-best-photo (attach)
@@ -168,20 +117,103 @@
              text)
      (if preview 0 1))))
 
+;; Database
+(def-db-init (db)
+  (%db-execute db "create table if not exists vk_walls (domain, last_id, next_fetch, period)")
+  (%db-execute db "create unique index if not exists vk_walls_domain_idx on vk_walls (domain)")
+
+  (%db-execute db "create table if not exists vk_chat_walls (chat_id, domain)")
+  (%db-execute db "create index if not exists vk_chat_walls_chat_idx on vk_chat_walls (chat_id)")
+  (%db-execute db "create index if not exists vk_chat_walls_domain_idx on vk_chat_walls (domain)"))
+
+(defun db/vk-ensure-domain (domain last-id)
+  (db-transaction (db)
+    (unless (%db-single db "select domain from vk_walls where domain = ?" domain)
+      (%db-execute db "insert into vk_walls (domain, last_id, period) values (?, ?, 300)" domain last-id))))
+
+(defun db/vk-get-domain-chats (domain)
+  (flatten (db-select "select chat_id from vk_chat_walls where domain = ?" domain)))
+
+(defun db/vk-get-chat-domains (chat-id)
+  (flatten (db-select "select domain from vk_chat_walls where chat_id  = ?" chat-id)))
+
+(defun db/vk-add-chat-domain (chat-id domain)
+  (db-execute "insert into vk_chat_walls (chat_id, domain) values (?, ?)" chat-id domain))
+
+(defun db/vk-remove-chat-domain (chat-id domain)
+  (db-execute "delete from vk_chat_walls where chat_id = ? and domain = ?" chat-id domain))
+
+(defun db/vk-get-active-walls ()
+  (db-select "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)
+  (db-execute "update vk_walls set last_id = ?, next_fetch = ?, period = ? where domain = ?" last-id next-fetch period domain))
+
+;; Cron
+(defcron process-walls ()
+  (loop for (domain last-id next-fetch period) in (db/vk-get-active-walls)
+     when (or (null next-fetch)
+              (local-time:timestamp> (local-time:now) (local-time:unix-to-timestamp next-fetch)))
+     do (progn
+          (log:info "Fetching wall" domain)
+          (handler-case
+              (let ((new-posts
+                     (remove last-id (reverse (aget "items" (vk-wall-get :domain domain)))
+                             :test #'>= :key (lambda (p) (aget "id" p))))
+                    name)
+                (setf period (adjust-period period (length new-posts)))
+                (when new-posts
+                  (setf name (vk-get-name domain)))
+                (dolist (post new-posts)
+                  (multiple-value-bind (text disable)
+                      (%format-wall-post domain name post)
+                    (dolist (chat-id (db/vk-get-domain-chats domain))
+                      (ignore-errors
+                        (telegram-send-message chat-id text
+                                               :parse-mode "Markdown"
+                                               :disable-web-preview disable))))
+                  (setf last-id (max last-id (aget "id" post)))))
+            (error (e) (log:error "~A" e)))
+          (db/vk-update-wall domain last-id
+                             (local-time:timestamp-to-unix
+                              (local-time:timestamp+ (local-time:now) period :sec))
+                             period))) ;; Update last-id, next-fetch and period
+  )
+
+;; Hooks
+(defparameter +akb-vk-domain+ "baneks" "VK.com username of 'B-category anekdotes'")
+(defvar *akb-max-posts* 10 "Maximum number of AKB posts to send at once")
+
+(defun format-akb (post)
+  (let* ((id (aget "id" post))
+         (url (format nil "https://vk.com/~A?w=wall~A_~A"
+                      +akb-vk-domain+ (aget "from_id" post) id)))
+    (format nil "~A~%~A" (aget "text" post) url)))
+
+(def-message-cmd-handler handler-akb (:akb)
+  (let ((total-aneks
+         (aget "count" (vk-wall-get :domain +akb-vk-domain+ :count 1 :offset 10000000))))
+    (dolist (post (aget "items" (vk-wall-get :domain +akb-vk-domain+
+                                             :count (min *akb-max-posts*
+                                                         (or (ignore-errors (parse-integer (car args)))
+                                                             1))
+                                             :offset (random total-aneks))))
+      (bot-send-message chat-id (format-akb post) :disable-web-preview 1))))
+
 (def-message-cmd-handler handler-cmd-wall (:wall)
-  (let ((domains (db-vk-get-chat-domains chat-id)))
+  (let ((domains (db/vk-get-chat-domains chat-id)))
     (if (null args)
         (%send-domains chat-id domains)
         (progn
           (dolist (url args)
             (handler-case
                 (let ((idx (parse-integer url)))
-                  (db-vk-remove-chat-domain chat-id (nth (1- idx) domains)))
+                  (db/vk-remove-chat-domain chat-id (nth (1- idx) domains)))
               (parse-error ()
                 (let* ((domain (%ensure-domain (%find-vk-domain url)))
                        (existing (find domain domains :test #'equal)))
                   (if existing
-                      (db-vk-remove-chat-domain chat-id domain)
-                      (db-vk-add-chat-domain chat-id domain))))
+                      (db/vk-remove-chat-domain chat-id domain)
+                      (db/vk-add-chat-domain chat-id domain))))
               (error (e) (log:error "~A" e))))
-          (%send-domains chat-id (db-vk-get-chat-domains chat-id))))))
+          (%send-domains chat-id (db/vk-get-chat-domains chat-id))))))