Fix "Too many open files" error
This commit is contained in:
contrapunctus
parent
fc47683184
commit
ab1dc18795
|
|
@ -27,79 +27,92 @@
|
||||||
(defclass chronometrist-sqlite-backend (chronometrist-backend chronometrist-file-backend-mixin)
|
(defclass chronometrist-sqlite-backend (chronometrist-backend chronometrist-file-backend-mixin)
|
||||||
((extension :initform "sqlite"
|
((extension :initform "sqlite"
|
||||||
:accessor chronometrist-backend-ext
|
:accessor chronometrist-backend-ext
|
||||||
:custom 'string)))
|
:custom 'string)
|
||||||
|
(connection :initform nil
|
||||||
|
:initarg :connection
|
||||||
|
:accessor chronometrist-backend-connection)))
|
||||||
|
|
||||||
(chronometrist-register-backend
|
(chronometrist-register-backend
|
||||||
:sqlite "Store records in SQLite database."
|
:sqlite "Store records in SQLite database."
|
||||||
(make-instance 'chronometrist-sqlite-backend :path chronometrist-file))
|
(make-instance 'chronometrist-sqlite-backend :path chronometrist-file))
|
||||||
|
|
||||||
|
(cl-defmethod initialize-instance :after ((backend chronometrist-sqlite-backend)
|
||||||
|
&rest _initargs)
|
||||||
|
"Initialize connection for BACKEND based on its file."
|
||||||
|
(with-slots (file connection) backend
|
||||||
|
(when (and file (not connection))
|
||||||
|
(setf connection (emacsql-sqlite file)))))
|
||||||
|
|
||||||
(cl-defmethod chronometrist-create-file ((backend chronometrist-sqlite-backend) &optional file)
|
(cl-defmethod chronometrist-create-file ((backend chronometrist-sqlite-backend) &optional file)
|
||||||
"Create file for BACKEND if it does not already exist.
|
"Create file for BACKEND if it does not already exist.
|
||||||
Return the emacsql-sqlite connection object."
|
Return the connection object from `emacsql-sqlite'."
|
||||||
(let ((file (or file (chronometrist-backend-file backend))))
|
(let* ((file (or file (chronometrist-backend-file backend)))
|
||||||
(if (file-exists-p file)
|
(db (or (chronometrist-backend-connection backend)
|
||||||
nil
|
(setf (chronometrist-backend-connection backend)
|
||||||
(cl-loop with db = (emacsql-sqlite file)
|
(emacsql-sqlite file)))))
|
||||||
for query in
|
(cl-loop
|
||||||
'(;; Properties are user-defined key-values stored as JSON.
|
for query in
|
||||||
[:create-table properties
|
'(;; Properties are user-defined key-values stored as JSON.
|
||||||
([(prop-id integer :primary-key)
|
[:create-table properties
|
||||||
(properties text :unique :not-null)])]
|
([(prop-id integer :primary-key)
|
||||||
;; An event is a timestamp with a name and optional properties.
|
(properties text :unique :not-null)])]
|
||||||
[:create-table event-names
|
;; An event is a timestamp with a name and optional properties.
|
||||||
([(name-id integer :primary-key)
|
[:create-table event-names
|
||||||
(name text :unique :not-null)])]
|
([(name-id integer :primary-key)
|
||||||
[:create-table events
|
(name text :unique :not-null)])]
|
||||||
([(event-id integer :primary-key)
|
[:create-table events
|
||||||
(name-id integer :not-null :references event-names [name-id])])]
|
([(event-id integer :primary-key)
|
||||||
;; An interval is a time range with a name and optional properties.
|
(name-id integer :not-null :references event-names [name-id])])]
|
||||||
[:create-table interval-names
|
;; An interval is a time range with a name and optional properties.
|
||||||
([(name-id integer :primary-key)
|
[:create-table interval-names
|
||||||
(name text :unique :not-null)])]
|
([(name-id integer :primary-key)
|
||||||
[:create-table intervals
|
(name text :unique :not-null)])]
|
||||||
([(interval-id integer :primary-key)
|
[:create-table intervals
|
||||||
(name-id integer :not-null :references interval-names [name-id])
|
([(interval-id integer :primary-key)
|
||||||
(start-time integer :not-null)
|
(name-id integer :not-null :references interval-names [name-id])
|
||||||
;; The latest interval may be ongoing, so the stop time may be NULL.
|
(start-time integer :not-null)
|
||||||
(stop-time integer)
|
;; The latest interval may be ongoing, so the stop time may be NULL.
|
||||||
(prop-id integer :references properties [prop-id])]
|
(stop-time integer)
|
||||||
(:unique [name-id start-time stop-time]))]
|
(prop-id integer :references properties [prop-id])]
|
||||||
;; A date contains one or more events and intervals. It may
|
(:unique [name-id start-time stop-time]))]
|
||||||
;; also contain properties.
|
;; A date contains one or more events and intervals. It may
|
||||||
[:create-table dates
|
;; also contain properties.
|
||||||
([(date-id integer :primary-key)
|
[:create-table dates
|
||||||
(date integer :unique :not-null)
|
([(date-id integer :primary-key)
|
||||||
(prop-id integer :references properties [prop-id])])]
|
(date integer :unique :not-null)
|
||||||
[:create-table date-events
|
(prop-id integer :references properties [prop-id])])]
|
||||||
([(date-id integer :not-null :references dates [date-id])
|
[:create-table date-events
|
||||||
(event-id integer :not-null :references events [event-id])])]
|
([(date-id integer :not-null :references dates [date-id])
|
||||||
[:create-table date-intervals
|
(event-id integer :not-null :references events [event-id])])]
|
||||||
([(date-id integer :not-null :references dates [date-id])
|
[:create-table date-intervals
|
||||||
(interval-id integer :not-null :references intervals [interval-id])])])
|
([(date-id integer :not-null :references dates [date-id])
|
||||||
do (emacsql db query)
|
(interval-id integer :not-null :references intervals [interval-id])])])
|
||||||
finally return db))))
|
do (emacsql db query)
|
||||||
|
finally return db)))
|
||||||
|
|
||||||
(defun chronometrist-iso-to-unix (timestamp)
|
(defun chronometrist-iso-to-unix (timestamp)
|
||||||
(truncate (float-time (parse-iso8601-time-string timestamp))))
|
(truncate (float-time (parse-iso8601-time-string timestamp))))
|
||||||
|
|
||||||
(cl-defmethod chronometrist-to-file (hash-table (backend chronometrist-sqlite-backend) file)
|
(cl-defmethod chronometrist-to-file (hash-table (backend chronometrist-sqlite-backend) file)
|
||||||
(delete-file file)
|
(with-slots (connection) backend
|
||||||
(chronometrist-create-file backend file)
|
(delete-file file)
|
||||||
(cl-loop with db = (emacsql-sqlite file)
|
(emacsql-close connection)
|
||||||
for date in (sort (hash-table-keys hash-table) #'string-lessp) do
|
(setf connection nil)
|
||||||
;; insert date if it does not exist
|
(chronometrist-create-file backend file)
|
||||||
(-let* ((date-unix (chronometrist-iso-to-unix date))
|
(cl-loop for date in (sort (hash-table-keys hash-table) #'string-lessp) do
|
||||||
((date-results &as (date-id))
|
;; insert date if it does not exist
|
||||||
(emacsql db [:select [date-id] :from dates :where (= date $s1)]
|
(-let* ((date-unix (chronometrist-iso-to-unix date))
|
||||||
date-unix)))
|
((date-results &as (date-id))
|
||||||
(unless date-results
|
(emacsql connection [:select [date-id] :from dates :where (= date $s1)]
|
||||||
(emacsql db [:insert-into dates [date] :values [$s1]] date-unix))
|
date-unix)))
|
||||||
;; XXX - insert date properties
|
(unless date-results
|
||||||
(cl-loop for plist in (gethash date hash-table) do
|
(emacsql connection [:insert-into dates [date] :values [$s1]] date-unix))
|
||||||
(chronometrist-insert backend plist)
|
;; XXX - insert date properties
|
||||||
;; XXX - insert events
|
(cl-loop for plist in (gethash date hash-table) do
|
||||||
))
|
(chronometrist-insert backend plist)
|
||||||
))
|
;; XXX - insert events
|
||||||
|
))
|
||||||
|
)))
|
||||||
|
|
||||||
;; predicate to find prop-id for property if it exists
|
;; predicate to find prop-id for property if it exists
|
||||||
;; insert property if it does not exist (procedure)
|
;; insert property if it does not exist (procedure)
|
||||||
|
|
@ -113,9 +126,8 @@ Properties are key-values excluding :name, :start, and :stop.
|
||||||
|
|
||||||
Insert nothing if the properties already exist. Return the
|
Insert nothing if the properties already exist. Return the
|
||||||
prop-id of the inserted or existing property."
|
prop-id of the inserted or existing property."
|
||||||
(with-slots (file) backend
|
(with-slots (file connection) backend
|
||||||
(-let* ((db (emacsql-sqlite file))
|
(-let* ((props-json (json-encode
|
||||||
(props-json (json-encode
|
|
||||||
;; `json-encode' throws an error for alists,
|
;; `json-encode' throws an error for alists,
|
||||||
;; so we convert any cons cells to lists
|
;; so we convert any cons cells to lists
|
||||||
(-tree-map (lambda (elt)
|
(-tree-map (lambda (elt)
|
||||||
|
|
@ -123,17 +135,17 @@ prop-id of the inserted or existing property."
|
||||||
(list (car elt) (cdr elt))
|
(list (car elt) (cdr elt))
|
||||||
elt))
|
elt))
|
||||||
(chronometrist-plist-key-values plist)))))
|
(chronometrist-plist-key-values plist)))))
|
||||||
(emacsql db [:insert-or-ignore-into properties [properties]
|
(emacsql connection
|
||||||
:values [$s1]]
|
[:insert-or-ignore-into properties [properties] :values [$s1]]
|
||||||
props-json)
|
props-json)
|
||||||
(caar (emacsql db [:select (funcall max prop-id) :from properties])))))
|
(caar (emacsql connection [:select (funcall max prop-id) :from properties])))))
|
||||||
|
|
||||||
(cl-defmethod chronometrist-insert ((backend chronometrist-sqlite-backend) plist)
|
(cl-defmethod chronometrist-insert ((backend chronometrist-sqlite-backend) plist)
|
||||||
(-let [(plist-1 plist-2) (chronometrist-split-plist plist)]
|
(-let (((plist-1 plist-2) (chronometrist-split-plist plist))
|
||||||
(cl-loop with db = (emacsql-sqlite (chronometrist-backend-file backend))
|
(db (chronometrist-backend-connection backend)))
|
||||||
for plist in (if (and plist-1 plist-2)
|
(cl-loop for plist in (if (and plist-1 plist-2)
|
||||||
(list plist-1 plist-2)
|
(list plist-1 plist-2)
|
||||||
(list plist))
|
(list plist))
|
||||||
do
|
do
|
||||||
(-let* (((&plist :name name :start start :stop stop) plist)
|
(-let* (((&plist :name name :start start :stop stop) plist)
|
||||||
(date-unix (chronometrist-iso-to-unix (chronometrist-iso-to-date start)))
|
(date-unix (chronometrist-iso-to-unix (chronometrist-iso-to-date start)))
|
||||||
|
|
|
||||||
|
|
@ -45,60 +45,74 @@
|
||||||
(defclass chronometrist-sqlite-backend (chronometrist-backend chronometrist-file-backend-mixin)
|
(defclass chronometrist-sqlite-backend (chronometrist-backend chronometrist-file-backend-mixin)
|
||||||
((extension :initform "sqlite"
|
((extension :initform "sqlite"
|
||||||
:accessor chronometrist-backend-ext
|
:accessor chronometrist-backend-ext
|
||||||
:custom 'string)))
|
:custom 'string)
|
||||||
|
(connection :initform nil
|
||||||
|
:initarg :connection
|
||||||
|
:accessor chronometrist-backend-connection)))
|
||||||
|
|
||||||
(chronometrist-register-backend
|
(chronometrist-register-backend
|
||||||
:sqlite "Store records in SQLite database."
|
:sqlite "Store records in SQLite database."
|
||||||
(make-instance 'chronometrist-sqlite-backend :path chronometrist-file))
|
(make-instance 'chronometrist-sqlite-backend :path chronometrist-file))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
|
** initialize-instance :method:
|
||||||
|
#+BEGIN_SRC emacs-lisp
|
||||||
|
(cl-defmethod initialize-instance :after ((backend chronometrist-sqlite-backend)
|
||||||
|
&rest _initargs)
|
||||||
|
"Initialize connection for BACKEND based on its file."
|
||||||
|
(with-slots (file connection) backend
|
||||||
|
(when (and file (not connection))
|
||||||
|
(setf connection (emacsql-sqlite file)))))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
** create-file
|
** create-file
|
||||||
#+BEGIN_SRC emacs-lisp
|
#+BEGIN_SRC emacs-lisp
|
||||||
(cl-defmethod chronometrist-create-file ((backend chronometrist-sqlite-backend) &optional file)
|
(cl-defmethod chronometrist-create-file ((backend chronometrist-sqlite-backend) &optional file)
|
||||||
"Create file for BACKEND if it does not already exist.
|
"Create file for BACKEND if it does not already exist.
|
||||||
Return the emacsql-sqlite connection object."
|
Return the connection object from `emacsql-sqlite'."
|
||||||
(let ((file (or file (chronometrist-backend-file backend))))
|
(let* ((file (or file (chronometrist-backend-file backend)))
|
||||||
(if (file-exists-p file)
|
(db (or (chronometrist-backend-connection backend)
|
||||||
nil
|
(setf (chronometrist-backend-connection backend)
|
||||||
(cl-loop with db = (emacsql-sqlite file)
|
(emacsql-sqlite file)))))
|
||||||
for query in
|
(cl-loop
|
||||||
'(;; Properties are user-defined key-values stored as JSON.
|
for query in
|
||||||
[:create-table properties
|
'(;; Properties are user-defined key-values stored as JSON.
|
||||||
([(prop-id integer :primary-key)
|
[:create-table properties
|
||||||
(properties text :unique :not-null)])]
|
([(prop-id integer :primary-key)
|
||||||
;; An event is a timestamp with a name and optional properties.
|
(properties text :unique :not-null)])]
|
||||||
[:create-table event-names
|
;; An event is a timestamp with a name and optional properties.
|
||||||
([(name-id integer :primary-key)
|
[:create-table event-names
|
||||||
(name text :unique :not-null)])]
|
([(name-id integer :primary-key)
|
||||||
[:create-table events
|
(name text :unique :not-null)])]
|
||||||
([(event-id integer :primary-key)
|
[:create-table events
|
||||||
(name-id integer :not-null :references event-names [name-id])])]
|
([(event-id integer :primary-key)
|
||||||
;; An interval is a time range with a name and optional properties.
|
(name-id integer :not-null :references event-names [name-id])])]
|
||||||
[:create-table interval-names
|
;; An interval is a time range with a name and optional properties.
|
||||||
([(name-id integer :primary-key)
|
[:create-table interval-names
|
||||||
(name text :unique :not-null)])]
|
([(name-id integer :primary-key)
|
||||||
[:create-table intervals
|
(name text :unique :not-null)])]
|
||||||
([(interval-id integer :primary-key)
|
[:create-table intervals
|
||||||
(name-id integer :not-null :references interval-names [name-id])
|
([(interval-id integer :primary-key)
|
||||||
(start-time integer :not-null)
|
(name-id integer :not-null :references interval-names [name-id])
|
||||||
;; The latest interval may be ongoing, so the stop time may be NULL.
|
(start-time integer :not-null)
|
||||||
(stop-time integer)
|
;; The latest interval may be ongoing, so the stop time may be NULL.
|
||||||
(prop-id integer :references properties [prop-id])]
|
(stop-time integer)
|
||||||
(:unique [name-id start-time stop-time]))]
|
(prop-id integer :references properties [prop-id])]
|
||||||
;; A date contains one or more events and intervals. It may
|
(:unique [name-id start-time stop-time]))]
|
||||||
;; also contain properties.
|
;; A date contains one or more events and intervals. It may
|
||||||
[:create-table dates
|
;; also contain properties.
|
||||||
([(date-id integer :primary-key)
|
[:create-table dates
|
||||||
(date integer :unique :not-null)
|
([(date-id integer :primary-key)
|
||||||
(prop-id integer :references properties [prop-id])])]
|
(date integer :unique :not-null)
|
||||||
[:create-table date-events
|
(prop-id integer :references properties [prop-id])])]
|
||||||
([(date-id integer :not-null :references dates [date-id])
|
[:create-table date-events
|
||||||
(event-id integer :not-null :references events [event-id])])]
|
([(date-id integer :not-null :references dates [date-id])
|
||||||
[:create-table date-intervals
|
(event-id integer :not-null :references events [event-id])])]
|
||||||
([(date-id integer :not-null :references dates [date-id])
|
[:create-table date-intervals
|
||||||
(interval-id integer :not-null :references intervals [interval-id])])])
|
([(date-id integer :not-null :references dates [date-id])
|
||||||
do (emacsql db query)
|
(interval-id integer :not-null :references intervals [interval-id])])])
|
||||||
finally return db))))
|
do (emacsql db query)
|
||||||
|
finally return db)))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
** to-file :method:
|
** to-file :method:
|
||||||
|
|
@ -121,23 +135,25 @@ Return the emacsql-sqlite connection object."
|
||||||
(truncate (float-time (parse-iso8601-time-string timestamp))))
|
(truncate (float-time (parse-iso8601-time-string timestamp))))
|
||||||
|
|
||||||
(cl-defmethod chronometrist-to-file (hash-table (backend chronometrist-sqlite-backend) file)
|
(cl-defmethod chronometrist-to-file (hash-table (backend chronometrist-sqlite-backend) file)
|
||||||
(delete-file file)
|
(with-slots (connection) backend
|
||||||
(chronometrist-create-file backend file)
|
(delete-file file)
|
||||||
(cl-loop with db = (emacsql-sqlite file)
|
(emacsql-close connection)
|
||||||
for date in (sort (hash-table-keys hash-table) #'string-lessp) do
|
(setf connection nil)
|
||||||
;; insert date if it does not exist
|
(chronometrist-create-file backend file)
|
||||||
(-let* ((date-unix (chronometrist-iso-to-unix date))
|
(cl-loop for date in (sort (hash-table-keys hash-table) #'string-lessp) do
|
||||||
((date-results &as (date-id))
|
;; insert date if it does not exist
|
||||||
(emacsql db [:select [date-id] :from dates :where (= date $s1)]
|
(-let* ((date-unix (chronometrist-iso-to-unix date))
|
||||||
date-unix)))
|
((date-results &as (date-id))
|
||||||
(unless date-results
|
(emacsql connection [:select [date-id] :from dates :where (= date $s1)]
|
||||||
(emacsql db [:insert-into dates [date] :values [$s1]] date-unix))
|
date-unix)))
|
||||||
;; XXX - insert date properties
|
(unless date-results
|
||||||
(cl-loop for plist in (gethash date hash-table) do
|
(emacsql connection [:insert-into dates [date] :values [$s1]] date-unix))
|
||||||
(chronometrist-insert backend plist)
|
;; XXX - insert date properties
|
||||||
;; XXX - insert events
|
(cl-loop for plist in (gethash date hash-table) do
|
||||||
))
|
(chronometrist-insert backend plist)
|
||||||
))
|
;; XXX - insert events
|
||||||
|
))
|
||||||
|
)))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
** insert
|
** insert
|
||||||
|
|
@ -154,9 +170,8 @@ Properties are key-values excluding :name, :start, and :stop.
|
||||||
|
|
||||||
Insert nothing if the properties already exist. Return the
|
Insert nothing if the properties already exist. Return the
|
||||||
prop-id of the inserted or existing property."
|
prop-id of the inserted or existing property."
|
||||||
(with-slots (file) backend
|
(with-slots (file connection) backend
|
||||||
(-let* ((db (emacsql-sqlite file))
|
(-let* ((props-json (json-encode
|
||||||
(props-json (json-encode
|
|
||||||
;; `json-encode' throws an error for alists,
|
;; `json-encode' throws an error for alists,
|
||||||
;; so we convert any cons cells to lists
|
;; so we convert any cons cells to lists
|
||||||
(-tree-map (lambda (elt)
|
(-tree-map (lambda (elt)
|
||||||
|
|
@ -164,17 +179,17 @@ prop-id of the inserted or existing property."
|
||||||
(list (car elt) (cdr elt))
|
(list (car elt) (cdr elt))
|
||||||
elt))
|
elt))
|
||||||
(chronometrist-plist-key-values plist)))))
|
(chronometrist-plist-key-values plist)))))
|
||||||
(emacsql db [:insert-or-ignore-into properties [properties]
|
(emacsql connection
|
||||||
:values [$s1]]
|
[:insert-or-ignore-into properties [properties] :values [$s1]]
|
||||||
props-json)
|
props-json)
|
||||||
(caar (emacsql db [:select (funcall max prop-id) :from properties])))))
|
(caar (emacsql connection [:select (funcall max prop-id) :from properties])))))
|
||||||
|
|
||||||
(cl-defmethod chronometrist-insert ((backend chronometrist-sqlite-backend) plist)
|
(cl-defmethod chronometrist-insert ((backend chronometrist-sqlite-backend) plist)
|
||||||
(-let [(plist-1 plist-2) (chronometrist-split-plist plist)]
|
(-let (((plist-1 plist-2) (chronometrist-split-plist plist))
|
||||||
(cl-loop with db = (emacsql-sqlite (chronometrist-backend-file backend))
|
(db (chronometrist-backend-connection backend)))
|
||||||
for plist in (if (and plist-1 plist-2)
|
(cl-loop for plist in (if (and plist-1 plist-2)
|
||||||
(list plist-1 plist-2)
|
(list plist-1 plist-2)
|
||||||
(list plist))
|
(list plist))
|
||||||
do
|
do
|
||||||
(-let* (((&plist :name name :start start :stop stop) plist)
|
(-let* (((&plist :name name :start start :stop stop) plist)
|
||||||
(date-unix (chronometrist-iso-to-unix (chronometrist-iso-to-date start)))
|
(date-unix (chronometrist-iso-to-unix (chronometrist-iso-to-date start)))
|
||||||
|
|
|
||||||
Reference in New Issue