combined all mapping functions in org sql

This commit is contained in:
ndwarshuis 2018-12-26 15:34:01 -05:00
parent 8fa83bf189
commit 723abb1909
1 changed files with 196 additions and 112 deletions

198
conf.org
View File

@ -2899,6 +2899,52 @@ parent until found or return nil if unfruitful."
(let ((parent (org-element-property :parent obj))) (let ((parent (org-element-property :parent obj)))
(nd/org-element-property-inherited prop parent)))))) (nd/org-element-property-inherited prop parent))))))
(defun nd/org-element-sort-headline-contents (headline)
"For a given org-element HEADLINE, return a sorted plist.
The plist will be structured as such:
(:planning '(data)
:logbook-drawer '(data)
:property-drawer '(data)
:other-contents '(data))
The planning entry will have the list of data associated with the
:planning property, and likewise with property-drawer. logbook-drawer
will be a drawer that is explicitly named `org-log-into-drawer' or
nil if not set. other-contents includes all other elements including
other drawers, list, paragraph elements, etc. If any of these groups
are missing, nil will be returned."
(when headline
;; assume there is only one section under one headline
(let* ((section (car (org-element-contents headline)))
(contents (org-element-contents section))
(plist-put-append
(lambda (plist property value)
(let* ((cur (plist-get plist property))
(new (append cur value)))
(plist-put plist property new))))
(get-pkey
(lambda (obj)
(let ((type (org-element-type obj)))
(cond
((eq 'planning type) :planning)
((eq 'property-drawer type) :property-drawer)
((and (eq 'drawer type)
(equal (org-element-property :drawer-name obj)
org-log-into-drawer))
:logbook-drawer)
(t :other-contents)))))
(sort-contents
(lambda (contents &optional acc)
(if (not contents)
acc
(let*
((cur (car contents))
(rem (cdr contents))
(pkey (funcall get-pkey cur))
(new-acc (funcall plist-put-append acc pkey cur)))
(funcall sort-contents rem new-acc))))))
(funcall sort-contents contents))))
#+END_SRC #+END_SRC
**** org sql constants and variables **** org sql constants and variables
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
@ -3036,7 +3082,7 @@ ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
(effort (org-element-property :EFFORT headline)) (effort (org-element-property :EFFORT headline))
(effort (nd/org-effort-to-int effort t)) (effort (nd/org-effort-to-int effort t))
(priority (org-element-property :priority headline)) (priority (org-element-property :priority headline))
tags table data ;; tags table data
(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))
(i-tags (when i-tags (split-string i-tags))) (i-tags (when i-tags (split-string i-tags)))
@ -3049,9 +3095,16 @@ ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
headline-file-offset headline-file-offset
(car tags) (car tags)
inherited)) inherited))
(setq tags (cdr tags)))))) (setq tags (cdr tags)))))
;; get headline section for processing drawers and contents
(contents-plist (nd/org-element-sort-headline-contents headline))
(property-drawer (plist-get contents-plist :property-drawer))
(node-properties (org-element-contents property-drawer))
(logbook-drawer (plist-get contents-plist :logbook-drawer))
(logbook-contents (org-element-contents logbook-drawer))
(hl-contents (plist-get contents-plist :other-contents)))
;; (unless source-file-path (print headline-text)))) ;; insert into headlines table
(nd/sql-insert nd/org-sqlite-db-path (nd/sql-insert nd/org-sqlite-db-path
"headlines" "headlines"
(list archive-file-path (list archive-file-path
@ -3070,53 +3123,31 @@ ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
;; TODO add contents ;; TODO add contents
nil)) nil))
;; insert into tags tables
(funcall insert-tags tags archive-file-path headline-file-offset 0) (funcall insert-tags tags archive-file-path headline-file-offset 0)
;; 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)))
(funcall insert-tags i-tags archive-file-path headline-file-offset 1))) (funcall insert-tags i-tags archive-file-path headline-file-offset 1)
(defun nd/org-element-clock-to-sql (clock archive-file-path) ;; insert properties into table
"Parse org-element CLOCK and insert data into TBL in sqlite DB. (nd/org-element-property-to-sql node-properties archive-file-path)
ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
(let* ((parent-headline (nd/org-element-get-parent-headline clock))
(headline-file-offset (org-element-property :begin parent-headline))
(clock-file-offset (org-element-property :begin clock))
(timestamp-obj (org-element-property :value clock))
(timestamp-type (org-element-property :type timestamp-obj))
time-start time-end)
;; process timestamp depending on if it is a range or singular
(cond ((eq 'inactive-range timestamp-type)
(setq time-start (org-timestamp-split-range timestamp-obj)
time-end (org-timestamp-split-range timestamp-obj t)))
((eq 'inactive timestamp-type)
(setq time-start timestamp-obj))
;; should never happen
(t (error (concat "unknown timestamp type: "
(symbol-name timestamp-type)))))
(setq time-start (nd/org-ts-format-to-iso
(org-element-property :raw-value time-start))
time-end (nd/org-ts-format-to-iso
(org-element-property :raw-value time-end)))
(nd/sql-insert nd/org-sqlite-db-path
"clocking"
(list archive-file-path
headline-file-offset
clock-file-offset
time-start
time-end
;; TODO add clocking note
nil))))
(defun nd/org-element-property-to-sql (np archive-file-path) ;; insert logbook entries into their tables
(nd/org-element-logbook-to-sql logbook-contents archive-file-path)))
(defun nd/org-element-property-to-sql (node-properties 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))) (when node-properties
(let* ((cur (car node-properties))
(rem (cdr node-properties))
(key-text (org-element-property :key cur)))
(unless (member key-text nd/org-sql-ignored-properties) (unless (member key-text nd/org-sql-ignored-properties)
(let* ((parent-headline (nd/org-element-get-parent-headline np)) (let* ((parent-headline (nd/org-element-get-parent-headline cur))
(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 cur))
(val-text (org-element-property :value np))) (val-text (org-element-property :value cur)))
(nd/sql-insert nd/org-sqlite-db-path (nd/sql-insert nd/org-sqlite-db-path
"properties" "properties"
(list archive-file-path (list archive-file-path
@ -3125,18 +3156,38 @@ ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
key-text key-text
val-text val-text
;; TODO add inherited flag ;; TODO add inherited flag
nil)))))) nil))))
(nd/org-element-property-to-sql rem archive-file-path))))
(defun nd/org-element-logbook-item-to-sql (item archive-file-path) (defun nd/org-element-logbook-to-sql (lb-contents archive-file-path &optional last-clock)
(when lb-contents
(let* ((cur (car lb-contents))
(rem (cdr lb-contents))
(type (org-element-type cur)))
(print type)
(cond
((eq 'plain-list type)
;; call some processing function and pass last-clock
(let ((contents (org-element-contents cur)))
(nd/org-element-logbook-item-to-sql contents archive-file-path))
(nd/org-element-logbook-to-sql rem archive-file-path))
((eq 'clock type)
;; call some processing function
(nd/org-element-clock-to-sql cur archive-file-path)
(nd/org-element-logbook-to-sql rem archive-file-path last-clock))
(t (error (concat "Unknown logbook entry type: " (symbol-name type))))))))
(defun nd/org-element-logbook-item-to-sql (items archive-file-path)
"Parse ITEM if in log drawer and add notes and log entries to db. "Parse ITEM if in log drawer and add notes and log entries to db.
ARCHIVE-FILE-PATH is the path to the archive file." ARCHIVE-FILE-PATH is the path to the archive file."
(let* ((parent-drawer (nd/org-element-get-parent-type 'drawer item)) ;; assume all items here are from a legit logbook drawer
(pd-name (org-element-property :drawer-name parent-drawer))) (when items
(when (equal org-log-into-drawer pd-name) (let* ((cur (car items))
(let* ((parent-headline (nd/org-element-get-parent-headline item)) (rem (cdr items))
(parent-headline (nd/org-element-get-parent-headline cur))
(headline-file-offset (org-element-property :begin parent-headline)) (headline-file-offset (org-element-property :begin parent-headline))
(entry-file-offset (org-element-property :begin item)) (entry-file-offset (org-element-property :begin cur))
(paragraph (nd/org-element-find-type 'paragraph item)) (paragraph (nd/org-element-find-type 'paragraph cur))
(contents (org-element-contents paragraph)) (contents (org-element-contents paragraph))
;; split entry into right / left components via linebreak ;; split entry into right / left components via linebreak
(left (nd/org-element-split-by-type 'line-break contents)) (left (nd/org-element-split-by-type 'line-break contents))
@ -3206,22 +3257,55 @@ ARCHIVE-FILE-PATH is the path to the archive file."
((memq note-type '(done refile note)) (ignore)) ((memq note-type '(done refile note)) (ignore))
;; this shouldn't happen ;; this shouldn't happen
(t (error (concat "Unknown entry type: " (symbol-name note-type)))))))))) (t (error (concat "Unknown entry type: " (symbol-name note-type))))))
(nd/org-element-logbook-item-to-sql rem 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.
ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
(let* ((parent-headline (nd/org-element-get-parent-headline clock))
(headline-file-offset (org-element-property :begin parent-headline))
(clock-file-offset (org-element-property :begin clock))
(timestamp-obj (org-element-property :value clock))
(timestamp-type (org-element-property :type timestamp-obj))
time-start time-end)
;; process timestamp depending on if it is a range or singular
(cond ((eq 'inactive-range timestamp-type)
(setq time-start (org-timestamp-split-range timestamp-obj)
time-end (org-timestamp-split-range timestamp-obj t)))
((eq 'inactive timestamp-type)
(setq time-start timestamp-obj))
;; should never happen
(t (error (concat "unknown timestamp type: "
(symbol-name timestamp-type)))))
(setq time-start (nd/org-ts-format-to-iso
(org-element-property :raw-value time-start))
time-end (nd/org-ts-format-to-iso
(org-element-property :raw-value time-end)))
(nd/sql-insert nd/org-sqlite-db-path
"clocking"
(list archive-file-path
headline-file-offset
clock-file-offset
time-start
time-end
;; TODO add clocking note
nil))))
(defun nd/org-archive-to-db () (defun nd/org-archive-to-db ()
"Transfer archive files to sqlite database." "Transfer archive files to sqlite database."
(let* ((rxv-path (expand-file-name "general.org_archive" org-directory)) (let* ((rxv-path (expand-file-name "test.org_archive" org-directory))
(tree (with-current-buffer (find-file-noselect rxv-path) (tree (with-current-buffer (find-file-noselect rxv-path)
(org-element-parse-buffer)))) (org-element-parse-buffer))))
(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 c rxv-path))) ;; (lambda (c) (nd/org-element-clock-to-sql c rxv-path)))
(org-element-map tree 'node-property ;; (org-element-map tree 'node-property
(lambda (n) (nd/org-element-property-to-sql n rxv-path))) ;; (lambda (n) (nd/org-element-property-to-sql n rxv-path)))
(org-element-map tree 'item ;; (org-element-map tree 'item
(lambda (i) (nd/org-element-logbook-item-to-sql i rxv-path))))) ;; (lambda (i) (nd/org-element-logbook-item-to-sql i rxv-path)))))
#+END_SRC #+END_SRC
* tools * tools
** printing ** printing