do not lock writes to db while running "./run.sh fetch"

3 files changed, 71 insertions, 64 deletions

diff --git a/bin/fetch.fnl b/bin/fetch.fnl
index 213475e..e7ee454 100644
--- a/bin/fetch.fnl
+++ b/bin/fetch.fnl
@@ -19,7 +19,7 @@
 (when _G.unpack
  (tset table :unpack _G.unpack))
 
-(local db (must (luna.db.open "file:var/db.sqlite?_journal=WAL&_sync=NORMAL")))
+(local db (must (luna.db.open "file:var/db.sqlite?_journal=WAL&_sync=NORMAL&_txlock=immediate")))
 (must
  (luna.db.exec db "
   PRAGMA foreign_keys=ON;
@@ -109,63 +109,70 @@
     (must (luna.db.exec-tx tx sql vars))))
 
 (fn store-products [tx products]
-  (when (< 0 (# products))
-    (local sql
-      (.. "INSERT OR REPLACE INTO products"
-          "(url, site, title, description, year, image, price, weight, volume, price_per, archived, creation_time)"
-          " VALUES "
-          (array.join
-            (map (fn [_ _] "(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)")
-                 products)
-            ", ")))
-    (local creation-time (now))
-    (local vars
-      (reduce
-        (fn [_ product rest]
-          (array.concat rest
-            [(or product.url "")
-             (or product.site "")
-             (or product.title "")
-             (or product.description "")
-             (or product.year 0)
-             (or product.image "")
-             (or product.price 0)
-             (or product.weight 0)
-             (or product.volume 0)
-             (or product.price-per 0)
-             (or product.archived false)
-             creation-time]))
-        products []))
-    (must (luna.db.exec-tx tx sql vars))
-
-    ;; store tags
-    (store-tags tx (array.unique
-                    (array.flatten
-                     (map (fn [_ v] v.tags) products))))
-    (store-product-tags tx products)
-
-    ;; archive previous products
-    (local site (. products 1 :site))
-    (when site
-     (must (luna.db.exec-tx
-             tx
-             "UPDATE products
-              SET    archived = true
-              WHERE  site = ?
-              AND    creation_time < ?"
-             [site creation-time])))))
-
-(fn populate-search-table [tx]
+  (local sql
+    (.. "INSERT OR REPLACE INTO products"
+        "(url, site, title, description, year, image, price, weight, volume, price_per, archived, creation_time)"
+        " VALUES "
+        (array.join
+          (map (fn [_ _] "(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)")
+               products)
+          ", ")))
+  (local creation-time (now))
+  (local vars
+    (reduce
+      (fn [_ product rest]
+        (array.concat rest
+          [(or product.url "")
+           (or product.site "")
+           (or product.title "")
+           (or product.description "")
+           (or product.year 0)
+           (or product.image "")
+           (or product.price 0)
+           (or product.weight 0)
+           (or product.volume 0)
+           (or product.price-per 0)
+           (or product.archived false)
+           creation-time]))
+      products []))
+  (must (luna.db.exec-tx tx sql vars))
+
+  ;; store tags
+  (store-tags tx (array.unique
+                  (array.flatten
+                   (map (fn [_ v] v.tags) products))))
+  (store-product-tags tx products)
+
+  ;; archive previous products
+  (local site (. products 1 :site))
+  (when site
+   (must (luna.db.exec-tx
+           tx
+           "UPDATE products
+            SET    archived = true
+            WHERE  site = ?
+            AND    creation_time < ?"
+           [site creation-time]))))
+
+(fn populate-search-table [db]
+  (local tx (must (luna.db.begin db)))
   (must (luna.db.exec-tx tx "DELETE FROM search" []))
   (must (luna.db.exec-tx tx "INSERT INTO search
-                             SELECT title, url, 'products'
-                             FROM products;" [])))
-
-;; replace with with-tx
-(local tx (must (luna.db.begin db)))
-(must (luna.db.exec-tx tx "DELETE FROM product_tags;" []))
-(each [_ parser (pairs [suhexuan])]
-  (store-products tx (parser.products)))
-(cache.clear-tx tx "page:")
-(populate-search-table tx)
-(must (luna.db.commit tx))
+                              SELECT title, url, 'products'
+                              FROM products;" []))
+  (must (luna.db.commit tx)))
+
+(each [_ parser (pairs [gorkovchay moychay ozchai suhexuan ipuer artoftea
+                        clubcha chaekshop])]
+  (local products (parser.products))
+  (when (< 0 (# products))
+    ;; replace with with-tx
+    (local tx (must (luna.db.begin db)))
+    (local (ok? err) (pcall store-products tx products))
+    (must (luna.db.commit tx))
+    (when (not ok?)
+     (print (string.format "Error fetching %s:\n%s"
+                          parser.title err)))))
+
+(cache.clear db "page:")
+(populate-search-table db)
diff --git a/bin/serve.fnl b/bin/serve.fnl
index 7385b53..927bd71 100644
--- a/bin/serve.fnl
+++ b/bin/serve.fnl
@@ -36,7 +36,7 @@
         (tset package :loaded module old))))))
 
 (local db
-  (must (luna.db.open "file:var/db.sqlite?_journal=WAL&_sync=NORMAL")))
+  (must (luna.db.open "file:var/db.sqlite?_journal=WAL&_sync=NORMAL&_txlock=immediate")))
 
 (local query-synonyms {
   "шэн" "шен"
diff --git a/lib/cache.fnl b/lib/cache.fnl
index 76ede13..fdde74c 100644
--- a/lib/cache.fnl
+++ b/lib/cache.fnl
@@ -15,11 +15,11 @@
                       [key value]))
   value)
 
-(fn clear-tx [tx prefix]
+(fn clear [db prefix]
   (if (= "string" (type prefix))
-    (must (luna.db.exec-tx tx "DELETE FROM cache WHERE key LIKE ?"
+    (must (luna.db.exec db "DELETE FROM cache WHERE key LIKE ?"
                            [(.. prefix "%")]))
-    (must (luna.db.exec-tx tx "DELETE FROM cache" []))))
+    (must (luna.db.exec db"DELETE FROM cache" []))))
 
 (fn wrap [db key f]
  (local cached (get db key))
@@ -28,4 +28,4 @@
    (let [res (f)]
      (if res (_set db key res) nil))))
 
-{: get :set _set : clear-tx : wrap}
+{:get get :set _set :clear clear :wrap wrap}