added logbook data to sqlite data

This commit is contained in:
ndwarshuis 2018-12-25 00:10:40 -05:00
parent 3b94902dbb
commit ca5011cb2b
1 changed files with 274 additions and 76 deletions

350
conf.org
View File

@ -2677,13 +2677,12 @@ Org mode is great and all, but in many cases, text files just won't cut it. Hard
(unless (file-exists-p nd/org-sqlite-db-path) (unless (file-exists-p nd/org-sqlite-db-path)
(process-file-shell-command (concat "touch " nd/org-sqlite-db-path)) (process-file-shell-command (concat "touch " nd/org-sqlite-db-path))
(nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-header-schema) (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-header-schema)
(nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-clocking-schema)
(nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-properties-schema) (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-properties-schema)
(nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-tags-schema))) (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-tags-schema)
;; (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-state-changes-schema) (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-clocking-schema)
;; (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-notes-schema) (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-logbook-schema)
;; (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-deadline-changes-schema) (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-state-changes-schema)
;; (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-schedule-changes-schema) (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-planning-changes-schema)))
(defun nd/sql-cmd (db sql) (defun nd/sql-cmd (db sql)
"Execute string SQL on database DB executing `sql-sqlite-program'. "Execute string SQL on database DB executing `sql-sqlite-program'.
@ -2729,6 +2728,14 @@ TYPE is an org element type symbol and OBJ is a list of elements/objects."
obj-cur obj-cur
(nd/org-element-find-type type obj-rem)))) (nd/org-element-find-type type obj-rem))))
(defun nd/org-element-get-parent-type (type obj)
"Return parent element of type TYPE for obj or nil if not found."
(when obj
(let ((parent (org-element-property :parent obj)))
(if (eq type (org-element-type parent))
parent
(nd/org-element-get-parent-type type parent)))))
(defun nd/org-element-get-parent-headline (obj) (defun nd/org-element-get-parent-headline (obj)
"Get the parent headline element (if any) of org-element OBJ." "Get the parent headline element (if any) of org-element OBJ."
(when obj (when obj
@ -2833,22 +2840,22 @@ ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
;; tags table ;; tags table
(tags (org-element-property :tags headline)) (tags (org-element-property :tags headline))
(i-tags (org-element-property :ARCHIVE_ITAGS headline)) (i-tags (org-element-property :ARCHIVE_ITAGS headline))
(insert-tags (lambda (tags afp hfo) (insert-tags (lambda (tags afp hfo inh)
(while tags (while tags
(nd/sql-insert nd/org-sqlite-db-path (nd/sql-insert nd/org-sqlite-db-path
"tags" "tags"
(list afp hfo (car tags) 1)) (list afp hfo (car tags) inh))
(setq tags (cdr tags)))))) (setq tags (cdr tags))))))
(nd/sql-insert nd/org-sqlite-db-path "headers" headline-data) (nd/sql-insert nd/org-sqlite-db-path "headlines" headline-data)
(insert-tags tags archive-file-path headline-file-offset) (funcall insert-tags tags archive-file-path headline-file-offset 0)
(when i-tags (setq i-tags (split-string i-tags))) (when i-tags (setq i-tags (split-string i-tags)))
;; retrieve parent tags if we want inheritance ;; retrieve parent tags if we want inheritance
(when nd/org-sql-use-tag-inheritance (when nd/org-sql-use-tag-inheritance
(setq i-tags (nd/org-element-get-parent-tags headline i-tags))) (setq i-tags (nd/org-element-get-parent-tags headline i-tags)))
(insert-tags i-tags archive-file-path headline-file-offset)) (funcall insert-tags i-tags archive-file-path headline-file-offset 1)))
(defun nd/org-element-clock-to-sql (db tbl clock archive-file-path) (defun nd/org-element-clock-to-sql (clock archive-file-path)
"Parse org-element CLOCK and insert data into TBL in sqlite DB. "Parse org-element CLOCK and insert data into TBL in sqlite DB.
ARCHIVE-FILE-PATH is the file path to the currently parsed archive file." ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
(let* ((parent-headline (nd/org-element-get-parent-headline clock)) (let* ((parent-headline (nd/org-element-get-parent-headline clock))
@ -2868,11 +2875,15 @@ ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
(symbol-name timestamp-type))))) (symbol-name timestamp-type)))))
(setq time-start (org-element-property :raw-value time-start) (setq time-start (org-element-property :raw-value time-start)
time-end (org-element-property :raw-value time-end)) time-end (org-element-property :raw-value time-end))
(nd/sql-insert db tbl (list archive-file-path (nd/sql-insert nd/org-sqlite-db-path
headline-file-offset "clocking"
clock-file-offset (list archive-file-path
time-start headline-file-offset
time-end)))) clock-file-offset
time-start
time-end
;; TODO add clocking note
nil))))
(defconst nd/org-sql-ignored-properties (defconst nd/org-sql-ignored-properties
'("ARCHIVE_TIME" "ARCHIVE_FILE" "ARCHIVE_OLPATH" "ARCHIVE_CATEGORY" '("ARCHIVE_TIME" "ARCHIVE_FILE" "ARCHIVE_OLPATH" "ARCHIVE_CATEGORY"
@ -2881,7 +2892,7 @@ ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
It is assumed these are used elsewhere and thus it would be redundant It is assumed these are used elsewhere and thus it would be redundant
to store them.") to store them.")
(defun nd/org-element-property-to-sql (db tbl np archive-file-path) (defun nd/org-element-property-to-sql (np archive-file-path)
"Parse node-property element NP and insert data into TBL in sqlite DB. "Parse node-property element NP and insert data into TBL in sqlite DB.
ARCHIVE-FILE-PATH is the file path to the currently parsed archive file." ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
(let ((key-text (org-element-property :key np))) (let ((key-text (org-element-property :key np)))
@ -2890,13 +2901,201 @@ ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
(headline-file-offset (org-element-property :begin parent-headline)) (headline-file-offset (org-element-property :begin parent-headline))
(property-file-offset (org-element-property :begin np)) (property-file-offset (org-element-property :begin np))
(val-text (org-element-property :value np))) (val-text (org-element-property :value np)))
(nd/sql-insert db tbl (list archive-file-path (nd/sql-insert nd/org-sqlite-db-path
headline-file-offset "properties"
property-file-offset (list archive-file-path
key-text headline-file-offset
val-text property-file-offset
;; TODO add inherited flag key-text
nil)))))) val-text
;; TODO add inherited flag
nil))))))
(defun nd/org-logbook-match-entry (entry-str)
"Test if ENTRY-STR matches `nd/org-log-note-headings-regexp'.
If found, returns list where car is the type and cdr is match data."
(let* ((scan
(lambda (str note-regex-alist)
(when note-regex-alist
(let* ((cur (car note-regex-alist))
(rem (cdr note-regex-alist))
(type (car cur))
(re (cdr cur)))
(if (string-match re str)
type
(funcall scan str rem))))))
(type (funcall scan entry-str nd/org-log-note-headings-regexp)))
(when type (cons type (match-data)))))
(defun nd/org-element-split-linebreak (contents &optional right)
"Split org-element sequence of objects CONTENTS by a linebreak.
If RIGHT is t, get the right half instead of the left."
(let ((scan
(lambda (c &optional acc)
(if c
(let ((cur (car c))
(rem (cdr c)))
(if (equal 'line-break (org-element-type cur))
(if right rem acc)
(funcall scan rem (append acc (list cur)))))
acc))))
(funcall scan contents)))
;; (defun nd/org-element-logbook-note-concat (entry-str &optional acc)
;; "Concat list ENTRY-STR which can be mix of strings and timestamps.
;; Timestamps are converted to their raw values upon concatenation."
;; (if entry-str
;; (let ((cur (car entry-str))
;; (rem (cdr entry-str)))
;; (cond ((eq 'timestamp (org-element-type cur))
;; (concat acc (org-element-property :raw-value cur)))
;; ;; if not a timestamp assume string
;; (t (concat acc cur)))
;; (nd/org-element-logbook-note-concat rem acc))
;; acc))
;; this function doesn't exist in vanilla org mode >:(
(defun nd/org-todo-keywords-stripped ()
"Return `org-todo-keywords' as string list w/o selectors.
Will likely match the value of `org-todo-keywords-1' in many cases,
but this has the advantage of being always available and comprehensive."
(mapcar
(lambda (s) (replace-regexp-in-string "(.*)" "" s))
(remove "|" (mapcan #'cdr (copy-tree org-todo-keywords)))))
(defun nd/org-log-note-headings-matcher ()
"Convert `org-log-note-headings' to a regex matcher.
See `org-log-note-headings' for escape sequences that are matched
and replaces by regexps that match what would be inserted in place
of the escapes."
;; no pipes :( so sad for mario bros
(let* ((escapes '("%u" "%U" "%t" "%T" "%d" "%D" "%s" "%S"))
(todo-list (nd/org-todo-keywords-stripped))
(todo-regexp (mapconcat #'regexp-quote todo-list "\\|"))
(ts-or-todo-regexp (concat "\"\\(" org-ts-regexp-inactive "\\|"
todo-regexp "\\)\""))
(org-ts-regexp-cap (concat "\\(" org-ts-regexp "\\)"))
(org-ts-regexp-inactive-cap (concat "\\(" org-ts-regexp-inactive "\\)"))
(re-matchers (list ".*"
".*"
org-ts-regexp-inactive-cap
org-ts-regexp-cap
org-ts-regexp-inactive-cap
org-ts-regexp-cap
ts-or-todo-regexp
ts-or-todo-regexp))
(re-matchers-pad (mapcar
(lambda (s)
(concat "[[:space:]]*" s "[[:space:]]*"))
re-matchers))
(re-no-pad-alist (mapcar* #'cons escapes escapes))
(re-match-alist (mapcar* #'cons escapes re-matchers-pad))
(apply2note
(lambda (n f)
(let ((note-type (car n))
(note-str (cdr n)))
(cons note-type (funcall f note-str)))))
(replace-esc
(lambda (n re)
(funcall apply2note
n
(lambda (s) (org-replace-escapes s re)))))
(shrink-space
(lambda (n)
(funcall apply2note
n
(lambda (s) (replace-regexp-in-string "\s+" " " s)))))
(new org-log-note-headings))
;; remove padding information by replacing all escape sequences
;; with their non-padded version and then removing extra spaces
(setq new (mapcar (lambda (n) (funcall replace-esc n re-no-pad-alist)) new))
(setq new (mapcar (lambda (n) (funcall shrink-space n)) new))
;; replace all escape sequences with regexps that match
;; the data to be inserted via the escape sequences
(setq new (mapcar (lambda (n) (funcall replace-esc n re-match-alist)) new))
;; filter out anything that is blank (eg default clock-in)
(seq-filter (lambda (s) (not (equal (cdr s) ""))) new)))
(defconst nd/org-log-note-headings-regexp
(nd/org-log-note-headings-matcher)
"Like `org-log-note-headings' but has regexp's instead of
escape sequences.")
(defun nd/org-element-logbook-item-to-sql (item archive-file-path)
"Parse ITEM if in log drawer and add notes and log entries to db.
ARCHIVE-FILE-PATH is the path to the archive file."
(let* ((parent-drawer (nd/org-element-get-parent-type 'drawer item))
(pd-name (org-element-property :drawer-name parent-drawer)))
(when (equal org-log-into-drawer pd-name)
(let* ((parent-headline (nd/org-element-get-parent-headline item))
(headline-file-offset (org-element-property :begin parent-headline))
(entry-file-offset (org-element-property :begin item))
(paragraph (nd/org-element-find-type 'paragraph item))
(contents (org-element-contents paragraph))
;; split entry into right / left components via linebreak
(left (nd/org-element-split-linebreak contents))
(right (nd/org-element-split-linebreak contents t))
(entry-str (string-trim (substring-no-properties
(org-element-interpret-data left))))
(note-parsed (nd/org-logbook-match-entry entry-str))
(note-type (car note-parsed))
(note-match (cdr note-parsed))
time-index time-logged logbook-data)
;; get time recorded based on note type
(set-match-data note-match)
(setq time-index
(cond
((memq note-type '(done note refile)) 1)
((memq note-type '(reschedule delschedule redeadline deldeadline)) 3)
((eq note-type 'state) 5)
(t (error (concat "Unknown type: " (symbol-name note-type))))))
(setq time-logged (match-string time-index entry-str))
;; insert into general logbook table first
(nd/sql-insert nd/org-sqlite-db-path
"logbook"
(list archive-file-path
headline-file-offset
entry-file-offset
time-logged
;; TODO add contents
nil))
;; insert into auxiliary logging tables
(cond
((eq note-type 'state)
(let* ((state-old (or (match-string 3 entry-str)
(match-string 4 entry-str)))
(state-new (or (match-string 1 entry-str)
(match-string 2 entry-str))))
(nd/sql-insert nd/org-sqlite-db-path
"state_changes"
(list archive-file-path
entry-file-offset
state-old
state-new))))
((memq note-type '(reschedule delschedule redeadline deldeadline))
(let* ((time-old (match-string 1 entry-str))
(schedule (memq note-type '(reschedule delschedule)))
(time-new (nd/org-element-timestamp-raw
(if schedule :scheduled :deadline)
parent-headline))
(planning-type (if schedule "s" "d")))
(nd/sql-insert nd/org-sqlite-db-path
"planning_changes"
(list archive-file-path
entry-file-offset
time-old
time-new
planning-type))))
;; no action required for these
((memq note-type '(done refile note)) (ignore))
;; this shouldn't happen
(t (error (concat "Unknown entry type: " (symbol-name note-type)))))))))
(defun nd/org-archive-to-db () (defun nd/org-archive-to-db ()
"Transfer archive files to sqlite database." "Transfer archive files to sqlite database."
@ -2908,11 +3107,11 @@ ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
(org-element-map tree 'headline (org-element-map tree 'headline
(lambda (h) (nd/org-element-header-to-sql h rxv-path))) (lambda (h) (nd/org-element-header-to-sql h rxv-path)))
(org-element-map tree 'clock (org-element-map tree 'clock
(lambda (c) (nd/org-element-clock-to-sql (lambda (c) (nd/org-element-clock-to-sql c rxv-path)))
nd/org-sqlite-db-path "clocking" c rxv-path)))
(org-element-map tree 'node-property (org-element-map tree 'node-property
(lambda (n) (nd/org-element-property-to-sql (lambda (n) (nd/org-element-property-to-sql n rxv-path)))
nd/org-sqlite-db-path "properties" n rxv-path))))) (org-element-map tree 'item
(lambda (i) (nd/org-element-logbook-item-to-sql i rxv-path)))))
;; (write-region "" nil dump-path) ;; (write-region "" nil dump-path)
;; (with-temp-file dump-path ;; (with-temp-file dump-path
;; (insert-file-contents dump-path) ;; (insert-file-contents dump-path)
@ -2936,30 +3135,9 @@ time_deadlined DATE,
effort TIME, effort TIME,
priority INTEGER, priority INTEGER,
content TEXT, content TEXT,
PRIMARY KEY (archive_file_path, headline_file_offset ASC));" PRIMARY KEY (archive_file_path ASC, headline_file_offset ASC));"
"Schema to build the headers table in the org archive db.") "Schema to build the headers table in the org archive db.")
(defconst nd/org-sqlite-clocking-schema
"CREATE TABLE clocking (
archive_file_path TEXT,
headline_file_offset INTEGER,
clock_file_offset INTEGER PRIMARY KEY,
time_start DATE NOT NULL,
time_end DATE,
FOREIGN KEY (archive_file_path, headline_file_offset)
REFERENCES headlines (archive_file_path, headline_file_offset));"
"Schema to build the clocking table in the org archive db.")
(defconst nd/org-sqlite-state-changes-schema
"CREATE TABLE state_changes (
path TEXT,
\"offset\" INTEGER,
state_old TEXT NOT NULL,
state_new TEXT NOT NULL,
time_changed DATE NOT NULL,
FOREIGN KEY (path, \"offset\") REFERENCES header (archive_path, archive_offset));"
"Schema to build the state changes table in the org archive db.")
(defconst nd/org-sqlite-tags-schema (defconst nd/org-sqlite-tags-schema
"CREATE TABLE tags ( "CREATE TABLE tags (
archive_file_path TEXT, archive_file_path TEXT,
@ -2983,33 +3161,53 @@ FOREIGN KEY (archive_file_path, headline_file_offset)
REFERENCES headlines (archive_file_path, headline_file_offset));" REFERENCES headlines (archive_file_path, headline_file_offset));"
"Schema to build the properties table in the org archive db.") "Schema to build the properties table in the org archive db.")
(defconst nd/org-sqlite-deadline-changes-schema (defconst nd/org-sqlite-clocking-schema
"CREATE TABLE deadline_changes ( "CREATE TABLE clocking (
path TEXT, \"offset\" INTEGER, archive_file_path TEXT,
time_old DATE NOT NULL, headline_file_offset INTEGER,
time_new DATE NOT NULL, clock_file_offset INTEGER,
time_changed DATE NOT NULL, time_start DATE NOT NULL,
FOREIGN KEY (path, \"offset\") REFERENCES header (archive_path, archive_offset));" time_end DATE,
"Schema to build the deadline changes table in the org archive db.") clock_note TEXT,
FOREIGN KEY (archive_file_path, headline_file_offset)
REFERENCES headlines (archive_file_path, headline_file_offset),
PRIMARY KEY (archive_file_path ASC, clock_file_offset ASC));"
"Schema to build the clocking table in the org archive db.")
(defconst nd/org-sqlite-schedule-changes-schema (defconst nd/org-sqlite-logbook-schema
"CREATE TABLE schedule_changes ( "CREATE TABLE logbook (
path TEXT, archive_file_path TEXT,
\"offset\" INTEGER, headline_file_offset INTEGER,
time_old DATE NOT NULL, entry_file_offset INTEGER,
time_new DATE NOT NULL, time_logged DATE NOT NULL,
time_changed DATE NOT NULL, note TEXT,
FOREIGN KEY (path, \"offset\") REFERENCES header (archive_path, archive_offset));" FOREIGN KEY (archive_file_path, headline_file_offset)
"Schema to build the schedule changes table in the org archive db.") REFERENCES headlines (archive_file_path, headline_file_offset),
PRIMARY KEY (archive_file_path ASC, entry_file_offset ASC));"
"Schema to build the logbook table in the org archive db.")
(defconst nd/org-sqlite-notes-schema (defconst nd/org-sqlite-state-changes-schema
"CREATE TABLE notes ( "CREATE TABLE state_changes (
path TEXT, archive_file_path TEXT,
\"offset\" INTEGER, entry_file_offset INTEGER,
contents TEXT, state_old TEXT NOT NULL,
time_written DATE NOT NULL, state_new TEXT NOT NULL,
FOREIGN KEY (path, \"offset\") REFERENCES header (archive_path, archive_offset));" FOREIGN KEY (archive_file_path, entry_file_offset)
"Schema to build the notes table in the org archive db.") REFERENCES headlines (archive_file_path, headline_file_offset),
PRIMARY KEY (archive_file_path ASC, entry_file_offset ASC));"
"Schema to build the state_changes table in the org archive db.")
(defconst nd/org-sqlite-planning-changes-schema
"CREATE TABLE planning_changes (
archive_file_path TEXT,
entry_file_offset INTEGER,
time_old DATE NOT NULL,
time_new DATE,
planning_type TEXT CHECK (planning_type = \\\"d\\\" or (planning_type = \\\"s\\\")),
FOREIGN KEY (archive_file_path, entry_file_offset)
REFERENCES logbook (archive_file_path, entry_file_offset),
PRIMARY KEY (archive_file_path ASC, entry_file_offset ASC));"
"Schema to build the planning_changes table in the org archive db.")
#+END_SRC #+END_SRC
* tools * tools
** printing ** printing