added generic iterator to manage sql data extraction
This commit is contained in:
parent
59d2eb7a78
commit
583f554b70
221
conf.org
221
conf.org
|
@ -3206,7 +3206,7 @@ These are the main functions to populate the db.
|
|||
(nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-planning-changes-schema)
|
||||
(nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-links-schema)))
|
||||
|
||||
(defun nd/org-sql-extract-lb-header (item-part &optional acc)
|
||||
(defun nd/org-sql-extract-lb-header (item-part acc)
|
||||
"Add specific data from logbook entry ITEM-PART to accumulator ACC.
|
||||
ITEM-PART is a partitions logbook item as described in
|
||||
`nd/org-sql-partition-item'. Note headings are parsed according to
|
||||
|
@ -3250,7 +3250,6 @@ nothing is added if a match is not found."
|
|||
;; header type not determined, therefore do nothing
|
||||
(t acc))))
|
||||
|
||||
;; TODO this gets called for clock notes?
|
||||
(defun nd/org-element-note-get-time-logged (item-part)
|
||||
"Return time-logged of ITEM-PART or nil if it cannot be determined.
|
||||
ITEM-PART is a partitioned logbook item as described in
|
||||
|
@ -3266,7 +3265,7 @@ ITEM-PART is a partitioned logbook item as described in
|
|||
(set-match-data (alist-get :match-data item-part))
|
||||
(nd/org-ts-format-to-iso (match-string time-index header-text)))))
|
||||
|
||||
(defun nd/org-sql-extract-lb-entry (item-part &optional acc)
|
||||
(defun nd/org-sql-extract-lb-entry (item-part acc)
|
||||
"Add data from logbook entry ITEM-PART to accumulator ACC.
|
||||
ITEM-PART is a partitioned logbook item as described in
|
||||
`nd/org-sql-partition-item'."
|
||||
|
@ -3288,31 +3287,23 @@ ITEM-PART is a partitioned logbook item as described in
|
|||
(acc* (nd/alist-put acc 'logbook logbook-data)))
|
||||
(nd/org-sql-extract-lb-header item-part acc*)))
|
||||
|
||||
(defun nd/org-sql-add-note-to-clock (clock-data item-part &optional acc)
|
||||
"Add ITEM-PART to CLOCK-DATA and add to accumulator ACC.
|
||||
ITEM-PART is a partitions logbook item as described in
|
||||
`nd/org-sql-partition-item'."
|
||||
(let* ((header-text (alist-get :header-text item-part))
|
||||
(clock-data* `(,@clock-data :clock_note ,header-text)))
|
||||
(nd/alist-put acc 'clocking clock-data*)))
|
||||
|
||||
(defun nd/org-logbook-parse-timestamp-range (ts)
|
||||
"Return start and end of timestamp TS depending on if it is a range.
|
||||
Return value will be a list of two elements if range and one if not."
|
||||
(when ts
|
||||
(let ((convert
|
||||
(let ((split
|
||||
(lambda (ts &optional end)
|
||||
(nd/org-ts-format-to-iso
|
||||
(org-element-property
|
||||
:raw-value
|
||||
(org-timestamp-split-range ts end))))))
|
||||
(if (eq (org-element-property :type ts) 'inactive-range)
|
||||
(let ((start (funcall convert ts))
|
||||
(end (funcall convert ts t)))
|
||||
(let ((start (funcall split ts))
|
||||
(end (funcall split ts t)))
|
||||
(cons start end))
|
||||
`(,(funcall convert ts))))))
|
||||
`(,(funcall split ts))))))
|
||||
|
||||
(defun nd/org-sql-extract-lb-clock (clock hl-part &optional acc item)
|
||||
(defun nd/org-sql-extract-lb-clock (clock acc hl-part &optional item)
|
||||
"Add data from logbook CLOCK to accumulator ACC.
|
||||
HL-PART is an object as returned by `nd/org-sql-partition-headline'
|
||||
and represents the headline surrounding the clock.
|
||||
|
@ -3336,38 +3327,40 @@ added to the clock, else add it as a normal logbook entry."
|
|||
(let* ((item-part (nd/org-sql-partition-item item hl-part))
|
||||
(item-type (alist-get :type item-part)))
|
||||
(if item-type
|
||||
;; if we know the type, add the clock and note
|
||||
;; separately
|
||||
(let ((acc* (nd/alist-put acc 'clocking clock-data)))
|
||||
(nd/org-sql-extract-lb-entry item-part acc*))
|
||||
(nd/org-sql-add-note-to-clock clock-data item-part acc))))))
|
||||
;; else add it with the clocking table
|
||||
(let* ((hdr-text (alist-get :header-text item-part))
|
||||
(clock-data* `(,@clock-data :clock_note ,hdr-text)))
|
||||
(nd/alist-put acc 'clocking clock-data*)))))))
|
||||
|
||||
(defun nd/org-sql-extract-lb-items (items hl-part &optional acc)
|
||||
(defun nd/org-sql-extract-lb-items (items acc hl-part)
|
||||
"Add data from logbook ITEMS to accumulator ACC.
|
||||
HL-PART is an object as returned by `nd/org-sql-partition-headline'
|
||||
and represents the headline surrounding the items."
|
||||
(if (not items)
|
||||
acc
|
||||
(let* ((cur (car items))
|
||||
(rem (cdr items))
|
||||
(item-part (nd/org-sql-partition-item cur hl-part))
|
||||
(acc* (nd/org-sql-extract-lb-entry item-part acc)))
|
||||
(nd/org-sql-extract-lb-items rem hl-part acc*))))
|
||||
(let ((into
|
||||
(lambda (item acc hl-part)
|
||||
(let ((item-part (nd/org-sql-partition-item item hl-part)))
|
||||
(nd/org-sql-extract-lb-entry item-part acc)))))
|
||||
(nd/org-sql-extract items into acc hl-part)))
|
||||
|
||||
(defun nd/org-sql-extract-lb-one (entry hl-part &optional acc)
|
||||
(defun nd/org-sql-extract-lb-one (entry acc hl-part)
|
||||
"Add data from logbook ENTRY to accumulator ACC.
|
||||
HL-PART is an object as returned by `nd/org-sql-partition-headline'
|
||||
and represents the headline surrounding the entry."
|
||||
(let ((type (org-element-type entry)))
|
||||
(cond
|
||||
((eq type 'clock)
|
||||
(nd/org-sql-extract-lb-clock entry hl-part acc))
|
||||
(nd/org-sql-extract-lb-clock entry acc hl-part))
|
||||
((eq type 'plain-list)
|
||||
(let ((items (org-element-contents entry)))
|
||||
(nd/org-sql-extract-lb-items items hl-part acc)))
|
||||
(nd/org-sql-extract-lb-items items acc hl-part)))
|
||||
;; TODO add an "UNKNOWN" logbook parser
|
||||
(t acc))))
|
||||
|
||||
;; TODO this triggers a sql syntax error when the note is not a clock note
|
||||
(defun nd/org-sql-extract-lb-two (entry1 entry2 hl-part &optional acc)
|
||||
(defun nd/org-sql-extract-lb-two (entry1 entry2 acc hl-part)
|
||||
"Add data from logbook ENTRY1 and ENTRY2 to accumulator ACC.
|
||||
HL-PART is an object as returned by `nd/org-sql-partition-headline'
|
||||
and represents the headline surrounding the entries. This assumes the
|
||||
|
@ -3376,8 +3369,8 @@ will check if the first item in ENTRY2 is part of the clock."
|
|||
(let* ((items (org-element-contents entry2))
|
||||
(first-item (car items))
|
||||
(rem-items (cdr items))
|
||||
(acc* (nd/org-sql-extract-lb-clock entry1 hl-part acc first-item)))
|
||||
(nd/org-sql-extract-lb-items rem-items hl-part acc*)))
|
||||
(acc* (nd/org-sql-extract-lb-clock entry1 acc hl-part first-item)))
|
||||
(nd/org-sql-extract-lb-items rem-items acc* hl-part)))
|
||||
|
||||
(defun nd/org-sql-find-logbook (contents)
|
||||
"Find the logbook drawer given CONTENTS from section of org headline.
|
||||
|
@ -3391,7 +3384,7 @@ ignored."
|
|||
(equal org-log-into-drawer (plist-get (car e) :drawer-name)))
|
||||
contents)))
|
||||
|
||||
(defun nd/org-sql-extract-lb (hl-part &optional acc)
|
||||
(defun nd/org-sql-extract-lb (hl-part acc)
|
||||
"Add logbook data from HL-PART and add to accumulator ACC.
|
||||
HL-PART is an object as returned by `nd/org-sql-partition-headline'."
|
||||
(let* ((sec (alist-get :section hl-part))
|
||||
|
@ -3414,47 +3407,40 @@ HL-PART is an object as returned by `nd/org-sql-partition-headline'."
|
|||
(eq type2 'plain-list)))
|
||||
(acc*
|
||||
(if try-clock-note
|
||||
(nd/org-sql-extract-lb-two cur1 cur2 hl-part acc)
|
||||
(nd/org-sql-extract-lb-one cur1 hl-part acc)))
|
||||
(nd/org-sql-extract-lb-two cur1 cur2 acc hl-part)
|
||||
(nd/org-sql-extract-lb-one cur1 acc hl-part)))
|
||||
(rem (if try-clock-note (cddr contents) (cdr contents))))
|
||||
(funcall scan rem acc*))))))
|
||||
(funcall scan lb-contents acc)))
|
||||
|
||||
(defun nd/org-sql-extract-properties (hl-part &optional acc)
|
||||
(defun nd/org-sql-extract-properties (hl-part acc)
|
||||
"Add properties data from HL-PART and add to accumulator ACC.
|
||||
HL-PART is an object as returned by `nd/org-sql-partition-headline'."
|
||||
(let* ((hl (alist-get :headline hl-part))
|
||||
(sec (alist-get :section hl-part))
|
||||
(let* ((sec (alist-get :section hl-part))
|
||||
(prop-drawer (assoc 'property-drawer sec))
|
||||
(node-props (org-element-contents prop-drawer))
|
||||
(scan
|
||||
(lambda (node-props hl-part &optional acc)
|
||||
(if (not node-props)
|
||||
acc
|
||||
(let* ((cur (car node-props))
|
||||
(rem (cdr node-props))
|
||||
(hl (alist-get :headline hl-part))
|
||||
(fp (alist-get :filepath hl-part))
|
||||
(offset (org-element-property :begin hl))
|
||||
(np-offset (org-element-property :begin cur))
|
||||
(key (org-element-property :key cur))
|
||||
(val (org-element-property :value cur))
|
||||
(prop-data (list :archive_file_path fp
|
||||
:headline_file_offset offset
|
||||
:property_file_offset np-offset
|
||||
:key_text key
|
||||
:val_text val
|
||||
;; TODO add inherited flag
|
||||
:inherited nil))
|
||||
(acc*
|
||||
(if (member key nd/org-sql-ignored-properties)
|
||||
acc
|
||||
(nd/alist-put acc 'properties prop-data))))
|
||||
(funcall scan rem hl-part acc*))))))
|
||||
(nd/org-sql-extract-property node-props hl-part acc)))
|
||||
(into
|
||||
(lambda (np acc hl-part)
|
||||
(let ((key (org-element-property :key np)))
|
||||
(if (member key nd/org-sql-ignored-properties)
|
||||
acc
|
||||
(let* ((hl (alist-get :headline hl-part))
|
||||
(fp (alist-get :filepath hl-part))
|
||||
(hl-offset (org-element-property :begin hl))
|
||||
(np-offset (org-element-property :begin np))
|
||||
(val (org-element-property :value np))
|
||||
(prop-data (list :archive_file_path fp
|
||||
:headline_file_offset hl-offset
|
||||
:property_file_offset np-offset
|
||||
:key_text key
|
||||
:val_text val
|
||||
;; TODO add inherited flag
|
||||
:inherited nil)))
|
||||
(nd/alist-put acc 'properties prop-data)))))))
|
||||
(nd/org-sql-extract node-props into acc hl-part)))
|
||||
|
||||
(defun nd/org-sql-extract-tags (hl-part &optional acc)
|
||||
"Add tags data from HL-PART and add to accumulator ACC.
|
||||
(defun nd/org-sql-extract-tags (hl-part acc)
|
||||
"Extract tags data from HL-PART and add to accumulator ACC.
|
||||
HL-PART is an object as returned by `nd/org-sql-partition-headline'."
|
||||
(let* ((hl (alist-get :headline hl-part))
|
||||
(tags (org-element-property :tags hl))
|
||||
|
@ -3465,66 +3451,55 @@ HL-PART is an object as returned by `nd/org-sql-partition-headline'."
|
|||
(i-tags (if nd/org-sql-use-tag-inheritance
|
||||
(nd/org-element-get-parent-tags hl i-tags)
|
||||
i-tags))
|
||||
(scan
|
||||
(lambda (tags hl-part &optional acc inherited)
|
||||
(if (not tags)
|
||||
acc
|
||||
(let* ((cur (car tags))
|
||||
(rem (cdr tags))
|
||||
(hl (alist-get :headline hl-part))
|
||||
(fp (alist-get :filepath hl-part))
|
||||
(offset (org-element-property :begin hl))
|
||||
(i (if inherited 1 0))
|
||||
(tags-data (list :archive_file_path fp
|
||||
:headline_file_offset offset
|
||||
:tag cur
|
||||
:inherited i))
|
||||
(acc* (nd/alist-put acc 'tags tags-data)))
|
||||
(funcall scan rem hl-part acc* inherited)))))
|
||||
(acc* (funcall scan tags hl-part acc)))
|
||||
(funcall scan i-tags hl-part acc* t)))
|
||||
(into
|
||||
(lambda (tag acc hl-part &optional inherited)
|
||||
(let* ((hl (alist-get :headline hl-part))
|
||||
(fp (alist-get :filepath hl-part))
|
||||
(offset (org-element-property :begin hl))
|
||||
(i (if inherited 1 0))
|
||||
(tags-data (list :archive_file_path fp
|
||||
:headline_file_offset offset
|
||||
:tag tag
|
||||
:inherited i)))
|
||||
(nd/alist-put acc 'tags tags-data))))
|
||||
(acc* (nd/org-sql-extract tags into acc hl-part)))
|
||||
(nd/org-sql-extract i-tags into acc* hl-part t)))
|
||||
|
||||
(defun nd/org-sql-extract-scanner (objs fun acc &rest args)
|
||||
"Recursively iterate through OBJS and add them to accumulator ACC.
|
||||
FUN is a function that takes a single object from OBJS, processes it,
|
||||
and adds it to ACC before returning a new ACC. Remaining ARGS will be
|
||||
passed to FUN."
|
||||
(defun nd/org-sql-extract (objs fun acc &rest args)
|
||||
"Iterate through OBJS and add them to accumulator ACC using FUN.
|
||||
FUN is a function that takes a single object from OBJS, the accumulator,
|
||||
and ARGS. FUN adds OBJ to ACC and returns a new ACC."
|
||||
(if (not objs)
|
||||
acc
|
||||
(let* ((cur (car objs))
|
||||
(rem (cdr objs))
|
||||
(acc* (apply fun cur acc args)))
|
||||
(apply #'nd/org-sql-extract-scanner rem fun acc args))))
|
||||
(apply #'nd/org-sql-extract rem fun acc* args))))
|
||||
|
||||
(defun nd/org-sql-extract-links (hl-part &optional acc)
|
||||
"Add link data from headline HL-PART to accumulator ACC.
|
||||
HL-PART is an object as returned by `nd/org-sql-partition-headline'."
|
||||
(let* ((sec (alist-get :section hl-part))
|
||||
(links (org-element-map sec 'link #'identity))
|
||||
(scan
|
||||
(lambda (links hl-part &optional acc)
|
||||
(if (not links)
|
||||
acc
|
||||
(let* ((cur (car links))
|
||||
(rem (cdr links))
|
||||
(fp (alist-get :filepath hl-part))
|
||||
(into
|
||||
(lambda (ln acc hl-part)
|
||||
(let* ((fp (alist-get :filepath hl-part))
|
||||
(hl (alist-get :headline hl-part))
|
||||
(hl-offset (org-element-property :begin hl))
|
||||
(ln-offset (org-element-property :begin cur))
|
||||
(ln-path (org-element-property :path cur))
|
||||
(ln-text (org-element-contents cur))
|
||||
(ln-offset (org-element-property :begin ln))
|
||||
(ln-path (org-element-property :path ln))
|
||||
(ln-text (org-element-contents ln))
|
||||
(ln-text (mapcar #'nd/strip-string ln-text))
|
||||
(ln-text (string-join ln-text))
|
||||
(ln-type (org-element-property :type cur))
|
||||
(ln-type (org-element-property :type ln))
|
||||
(ln-data (list :archive_file_path fp
|
||||
:headline_file_offset hl-offset
|
||||
:link_file_offset ln-offset
|
||||
:link_path ln-path
|
||||
:link_text ln-text
|
||||
:link_type ln-type))
|
||||
(acc* (nd/alist-put acc 'links ln-data)))
|
||||
(funcall scan rem hl-part acc*))))))
|
||||
(funcall scan links hl-part acc)))
|
||||
:link_type ln-type)))
|
||||
(nd/alist-put acc 'links ln-data)))))
|
||||
(nd/org-sql-extract links into acc hl-part)))
|
||||
|
||||
(defun nd/org-sql-extract-headline (hl-part &optional acc)
|
||||
"Add general data from headline HL-PART to accumulator ACC.
|
||||
|
@ -3567,24 +3542,22 @@ HL-PART is an object as returned by `nd/org-sql-partition-headline'."
|
|||
:content nil)))
|
||||
(nd/alist-put acc 'headlines hl-data)))
|
||||
|
||||
(defun nd/org-sql-extract-headlines-all (headlines fp &optional acc)
|
||||
(defun nd/org-sql-extract-headlines (headlines acc fp)
|
||||
"Extract data from HEADLINES and add to accumulator ACC.
|
||||
FP is the file path containing the headlines."
|
||||
(if (not headlines)
|
||||
acc
|
||||
(let* ((cur (car headlines))
|
||||
(rem (cdr headlines))
|
||||
(hl-part (nd/org-sql-partition-headline cur fp))
|
||||
(hl-sub (alist-get :subheadlines hl-part))
|
||||
(acc* (nd/org-sql-extract-headline hl-part acc))
|
||||
(acc* (nd/org-sql-extract-links hl-part acc*))
|
||||
(acc* (nd/org-sql-extract-tags hl-part acc*))
|
||||
(acc* (nd/org-sql-extract-properties hl-part acc*))
|
||||
(acc* (nd/org-sql-extract-lb hl-part acc*))
|
||||
(acc* (nd/org-sql-extract-headlines-all hl-sub fp acc*)))
|
||||
(nd/org-sql-extract-headlines-all rem fp acc*))))
|
||||
FP is the path to the file containing the headlines."
|
||||
(let ((into
|
||||
(lambda (hl acc fp)
|
||||
(let* ((hl-part (nd/org-sql-partition-headline hl fp))
|
||||
(hl-sub (alist-get :subheadlines hl-part))
|
||||
(acc* (nd/org-sql-extract-headline hl-part acc))
|
||||
(acc* (nd/org-sql-extract-links hl-part acc*))
|
||||
(acc* (nd/org-sql-extract-tags hl-part acc*))
|
||||
(acc* (nd/org-sql-extract-properties hl-part acc*))
|
||||
(acc* (nd/org-sql-extract-lb hl-part acc*)))
|
||||
(nd/org-sql-extract-headlines hl-sub acc* fp)))))
|
||||
(nd/org-sql-extract headlines into acc fp)))
|
||||
|
||||
(defun nd/org-sql-extract ()
|
||||
(defun nd/org-sql-extract-files ()
|
||||
"Return a plist of data to be inserted into sql database."
|
||||
(let* ((rxv-path (expand-file-name "test.org_archive" org-directory))
|
||||
;; TODO files need to be already open???
|
||||
|
@ -3594,16 +3567,12 @@ FP is the file path containing the headlines."
|
|||
(headlines (if (eq 'section (org-element-type (car contents)))
|
||||
(cdr contents)
|
||||
contents)))
|
||||
(nd/org-sql-extract-headlines-all headlines rxv-path)))
|
||||
(nd/org-sql-extract-headlines headlines nil rxv-path)))
|
||||
|
||||
(defun nd/org-archive-to-db ()
|
||||
"Transfer archive files to sqlite database."
|
||||
(let ((sql-data (nd/org-sql-extract)))
|
||||
(let ((sql-data (nd/org-sql-extract-files)))
|
||||
(nd/sql-insert-multi nd/org-sqlite-db-path sql-data)))
|
||||
|
||||
;; these are obviously temporary
|
||||
(setq max-lisp-eval-depth 100000
|
||||
max-specpdl-size 800000)
|
||||
#+END_SRC
|
||||
* tools
|
||||
** printing
|
||||
|
|
Loading…
Reference in New Issue