From 55f80b2ca4c8d44255e38ef2eee4564501aa83ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 17 Aug 2020 18:23:08 +0200 Subject: MOORE --- module/vcomponent/parse.scm | 99 +------------------------------- module/vcomponent/vdir/parse.scm | 102 +++++++++++++++++++++++++++++++++ module/vcomponent/vdir/save-delete.scm | 55 ++++++++++++++++++ 3 files changed, 159 insertions(+), 97 deletions(-) create mode 100644 module/vcomponent/vdir/parse.scm create mode 100644 module/vcomponent/vdir/save-delete.scm (limited to 'module/vcomponent') diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm index 67d66b02..290a8d3e 100644 --- a/module/vcomponent/parse.scm +++ b/module/vcomponent/parse.scm @@ -1,107 +1,13 @@ -;;; Commentary: -;; Code for parsing vdir's and icalendar files. -;; This module handles the finding of files, while -;; (vcomponent parse ical) handles reading data from icalendar files. -;;; Code: - (define-module (vcomponent parse) - :use-module (srfi srfi-1) - - :use-module ((ice-9 hash-table) :select (alist->hash-table)) - :use-module ((ice-9 rdelim) :select (read-line)) - :use-module ((ice-9 ftw) :select (scandir ftw)) - :use-module (util) - :use-module (util time) - :use-module (util exceptions) :use-module (vcomponent base) + :use-module ((vcomponent vdir parse) :select (parse-vdir)) + :use-module ((util time) :select (report-time!)) :use-module (vcomponent ical parse) :re-export (parse-calendar) ) - - - -;; All VTIMEZONE's seem to be in "local" time in relation to -;; themselves. Therefore, a simple comparison should work, -;; and then the TZOFFSETTO properties can be subtd. -(define (parse-vdir path) - (let ((/ (lambda args (string-join args file-name-separator-string 'infix)))) - (let ((color - (catch 'system-error - (lambda () (call-with-input-file (/ path "color") read-line)) - (const "#FFFFFF"))) - (name - (catch 'system-error - (lambda () (call-with-input-file (/ path "displayname") read-line)) - (const #f)))) - - (reduce (lambda (item calendar) - - (define-values (events other) (partition (lambda (e) (eq? 'VEVENT (type e))) - (children item))) - - - ;; (assert (eq? 'VCALENDAR (type calendar))) - (assert (eq? 'VCALENDAR (type item))) - - (for child in (children item) - (set! (prop child '-X-HNH-FILENAME) - (prop (parent child) '-X-HNH-FILENAME))) - - ;; NOTE The vdir standard says that each file should contain - ;; EXACTLY one event. It can however contain multiple VEVENT - ;; components, but they are still the same event. - ;; In our case this means exceptions to reccurence rules, which - ;; is set up here, and then later handled in rrule-generate. - ;; NOTE These events also share UID, but are diferentiated - ;; by RECURRENCE-ID. As far as I can tell this goes against - ;; the standard. Section 3.8.4.4. - (case (length events) - [(0) (warning "No events in component~%~a" - (prop item '-X-HNH-FILENAME))] - [(1) - (let ((child (car events))) - (assert (memv (type child) '(VTIMEZONE VEVENT))) - (add-child! calendar child))] - - ;; two or more - [else - - ;; Sorting on SEQUENCE here would have been nice. - ;; But the patches can apparently share a sequence number - ;; of 0 with the original event! - ;; (╯°□°）╯ ┻━┻ - (let* ((head (find (negate (extract 'RECURRENCE-ID)) - events)) - (rest (delete head events eq?))) - - (set! (prop head '-X-HNH-ALTERNATIVES) - (alist->hash-table - (map cons - (map (extract 'RECURRENCE-ID) rest) - rest)) - #; - (sort*! rest ;; HERE - date/-time< (extract 'RECURRENCE-ID))) - (add-child! calendar head))]) - - ;; return - calendar) - (make-vcomponent) - (map #; (@ (ice-9 threads) par-map) - (lambda (fname) - (let ((fullname (/ path fname))) - (let ((cal (call-with-input-file fullname - parse-calendar))) - (set! (prop cal 'COLOR) color - (prop cal 'NAME) name - (prop cal '-X-HNH-FILENAME) fullname) - cal))) - (scandir path (lambda (s) (and (not (string= "." (string-take s 1))) - (string= "ics" (string-take-right s 3)))))))))) - ;; Parse a vdir or ics file at the given path. (define-public (parse-cal-path path) ;; TODO check (access? path R_OK) ? @@ -127,4 +33,3 @@ (string-append "[" (basename path) "]")))) cal) - diff --git a/module/vcomponent/vdir/parse.scm b/module/vcomponent/vdir/parse.scm new file mode 100644 index 00000000..ae4ea692 --- /dev/null +++ b/module/vcomponent/vdir/parse.scm @@ -0,0 +1,102 @@ +;;; Commentary: +;; Code for parsing vdir's and icalendar files. +;; This module handles the finding of files, while +;; (vcomponent parse ical) handles reading data from icalendar files. +;;; Code: + +(define-module (vcomponent parse) + :use-module (srfi srfi-1) + + :use-module ((ice-9 hash-table) :select (alist->hash-table)) + :use-module ((ice-9 rdelim) :select (read-line)) + :use-module ((ice-9 ftw) :select (scandir ftw)) + + :use-module (util) + :use-module (util exceptions) + :use-module (vcomponent base) + + :use-module (vcomponent ical parse) + ) + + + + +;; All VTIMEZONE's seem to be in "local" time in relation to +;; themselves. Therefore, a simple comparison should work, +;; and then the TZOFFSETTO properties can be subtd. +(define (parse-vdir path) + (let ((/ (lambda args (string-join args file-name-separator-string 'infix)))) + (let ((color + (catch 'system-error + (lambda () (call-with-input-file (/ path "color") read-line)) + (const "#FFFFFF"))) + (name + (catch 'system-error + (lambda () (call-with-input-file (/ path "displayname") read-line)) + (const #f)))) + + (reduce (lambda (item calendar) + + (define-values (events other) (partition (lambda (e) (eq? 'VEVENT (type e))) + (children item))) + + + ;; (assert (eq? 'VCALENDAR (type calendar))) + (assert (eq? 'VCALENDAR (type item))) + + (for child in (children item) + (set! (prop child '-X-HNH-FILENAME) + (prop (parent child) '-X-HNH-FILENAME))) + + ;; NOTE The vdir standard says that each file should contain + ;; EXACTLY one event. It can however contain multiple VEVENT + ;; components, but they are still the same event. + ;; In our case this means exceptions to reccurence rules, which + ;; is set up here, and then later handled in rrule-generate. + ;; NOTE These events also share UID, but are diferentiated + ;; by RECURRENCE-ID. As far as I can tell this goes against + ;; the standard. Section 3.8.4.4. + (case (length events) + [(0) (warning "No events in component~%~a" + (prop item '-X-HNH-FILENAME))] + [(1) + (let ((child (car events))) + (assert (memv (type child) '(VTIMEZONE VEVENT))) + (add-child! calendar child))] + + ;; two or more + [else + + ;; Sorting on SEQUENCE here would have been nice. + ;; But the patches can apparently share a sequence number + ;; of 0 with the original event! + ;; (╯°□°）╯ ┻━┻ + (let* ((head (find (negate (extract 'RECURRENCE-ID)) + events)) + (rest (delete head events eq?))) + + (set! (prop head '-X-HNH-ALTERNATIVES) + (alist->hash-table + (map cons + (map (extract 'RECURRENCE-ID) rest) + rest)) + #; + (sort*! rest ;; HERE + date/-time< (extract 'RECURRENCE-ID))) + (add-child! calendar head))]) + + ;; return + calendar) + (make-vcomponent) + (map #; (@ (ice-9 threads) par-map) + (lambda (fname) + (let ((fullname (/ path fname))) + (let ((cal (call-with-input-file fullname + parse-calendar))) + (set! (prop cal 'COLOR) color + (prop cal 'NAME) name + (prop cal '-X-HNH-FILENAME) fullname) + cal))) + (scandir path (lambda (s) (and (not (string= "." (string-take s 1))) + (string= "ics" (string-take-right s 3)))))))))) + diff --git a/module/vcomponent/vdir/save-delete.scm b/module/vcomponent/vdir/save-delete.scm new file mode 100644 index 00000000..02db9d7a --- /dev/null +++ b/module/vcomponent/vdir/save-delete.scm @@ -0,0 +1,55 @@ +;;; Commentary: +;;; Module for writing components to the vdir storage format. +;;; Currently also has some cases for "big" icalendar files, +;;; but those are currently unsupported. + +;;; TODO generalize save-event and remove-event into a general interface, +;;; which different database backends can implement. Actually, do that for all +;;; loading and writing. + +;;; Code: + +(define-module (vcomponent vdir save-delete) + :use-module (util) + :use-module (vcomponent ical output) + :use-module (vcomponent) + :use-module ((util io) :select (with-atomic-output-to-file)) + ) + + +(define / file-name-separator-string) + +(define-public (save-event event) + (define calendar (parent event)) + (case (prop calendar '-X-HNH-SOURCETYPE) + [(file) + (error "Importing into direct calendar files not supported")] + + [(vdir) + (let* ((uid (or (prop event 'UID) (uuidgen)))) + (set! (prop event 'UID) uid + ;; TODO use existing filename if present? + (prop event '-X-HNH-FILENAME) (string-append + (prop calendar '-X-HNH-DIRECTORY) + / uid ".ics")) + (with-atomic-output-to-file (prop event '-X-HNH-FILENAME) + (lambda () (print-components-with-fake-parent (list event)))) + uid)] + + [else + (error "Source of calendar unknown, aborting.") + ])) + + +(define-public (remove-event event) + (define calendar (parent event)) + (case (prop calendar '-X-HNH-SOURCETYPE) + [(file) + (error "Removing events from large files unsupported")] + + [(vdir) + (delete-file (prop event '-X-HNH-FILENAME))] + + [else + (error "Source of calendar unknown, aborting.") + ])) -- cgit v1.2.3