diff options
| -rw-r--r-- | modules/calendar-sync.el | 242 | ||||
| -rw-r--r-- | tests/test-calendar-sync-async-worker.el | 154 |
2 files changed, 339 insertions, 57 deletions
diff --git a/modules/calendar-sync.el b/modules/calendar-sync.el index b232567a..f87d0192 100644 --- a/modules/calendar-sync.el +++ b/modules/calendar-sync.el @@ -69,6 +69,15 @@ ;;; Code: +(require 'cl-lib) +(require 'subr-x) + +(defun calendar-sync--log-silently (format-string &rest args) + "Log FORMAT-STRING with ARGS without requiring the full config." + (if (fboundp 'cj/log-silently) + (apply #'cj/log-silently format-string args) + (apply #'message format-string args))) + ;;; Configuration (defgroup calendar-sync nil @@ -129,6 +138,17 @@ Large calendars (thousands of events) may need more time on slow connections. A separate 10-second connect timeout ensures fast failure when a host is unreachable.") +(defvar calendar-sync--module-file + (let* ((loaded-file (or load-file-name buffer-file-name)) + (source-file (when loaded-file + (concat (file-name-sans-extension loaded-file) ".el")))) + (if (and source-file (file-readable-p source-file)) + source-file + loaded-file)) + "Absolute path to this module file. +Used by the batch conversion worker so it can load the same parser code +without loading the user's init file.") + ;;; Internal state (defvar calendar-sync--timer nil @@ -209,7 +229,7 @@ Example: -21600 → 'UTC-6' or 'UTC-6:00'." (dolist (entry cal-states) (puthash (car entry) (cdr entry) calendar-sync--calendar-states))))) (error - (cj/log-silently "calendar-sync: Error loading state: %s" (error-message-string err)))))) + (calendar-sync--log-silently "calendar-sync: Error loading state: %s" (error-message-string err)))))) (defun calendar-sync--get-calendar-state (calendar-name) "Get state plist for CALENDAR-NAME, or nil if not found." @@ -773,7 +793,7 @@ TZ database as the `date' command." (nth 2 local) ; hour (nth 1 local))) ; minute (error - (cj/log-silently "calendar-sync: Error converting timezone %s: %s" + (calendar-sync--log-silently "calendar-sync: Error converting timezone %s: %s" source-tz (error-message-string err)) nil)))) @@ -978,7 +998,7 @@ BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." ;; Move to next interval week (setq current-date (calendar-sync--add-days current-date (* 7 interval)))) (when (>= iterations max-iterations) - (cj/log-silently "calendar-sync: WARNING: Hit max iterations (%d) expanding weekly event" max-iterations)) + (calendar-sync--log-silently "calendar-sync: WARNING: Hit max iterations (%d) expanding weekly event" max-iterations)) (nreverse occurrences))) (defun calendar-sync--expand-monthly (base-event rrule range) @@ -1011,7 +1031,7 @@ Filters out dates excluded via EXDATE properties." ('weekly (calendar-sync--expand-weekly base-event parsed-rrule range)) ('monthly (calendar-sync--expand-monthly base-event parsed-rrule range)) ('yearly (calendar-sync--expand-yearly base-event parsed-rrule range)) - (_ (cj/log-silently "calendar-sync: Unsupported RRULE frequency: %s" freq) + (_ (calendar-sync--log-silently "calendar-sync: Unsupported RRULE frequency: %s" freq) nil)))) ;; Filter out EXDATE occurrences (if exdates @@ -1163,8 +1183,8 @@ RECURRENCE-ID exceptions are applied to override specific occurrences." (push parsed parsed-events) (setq events-generated (1+ events-generated)))))))) (when (>= events-generated max-events) - (cj/log-silently "calendar-sync: WARNING: Hit max events limit (%d), some events may be missing" max-events)) - (cj/log-silently "calendar-sync: Processing %d events..." (length parsed-events)) + (calendar-sync--log-silently "calendar-sync: WARNING: Hit max events limit (%d), some events may be missing" max-events)) + (calendar-sync--log-silently "calendar-sync: Processing %d events..." (length parsed-events)) ;; Sort and convert to org format (let* ((sorted-events (sort parsed-events (lambda (a b) @@ -1177,7 +1197,7 @@ RECURRENCE-ID exceptions are applied to override specific occurrences." "\n") nil))) (error - (cj/log-silently "calendar-sync: Parse error: %s" (error-message-string err)) + (calendar-sync--log-silently "calendar-sync: Parse error: %s" (error-message-string err)) nil))) ;;; Sync functions @@ -1208,12 +1228,47 @@ invoked when the fetch completes, either successfully or with an error." (if (and (eq (process-status process) 'exit) (= (process-exit-status process) 0)) (calendar-sync--normalize-line-endings (buffer-string)) - (cj/log-silently "calendar-sync: Fetch error: curl failed: %s" (string-trim event)) + (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" (string-trim event)) nil)))) (kill-buffer buf) (funcall callback content)))))))) (error - (cj/log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) + (calendar-sync--log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) + (funcall callback nil)))) + +(defun calendar-sync--fetch-ics-file (url callback) + "Fetch .ics from URL to a temp file asynchronously. +Calls CALLBACK with the temp file path on success, or nil on error. The caller +owns deleting the temp file after a successful callback." + (condition-case err + (let ((buffer (generate-new-buffer " *calendar-sync-curl*")) + (temp-file (make-temp-file "calendar-sync-" nil ".ics"))) + (make-process + :name "calendar-sync-curl" + :buffer buffer + :command (list "curl" "-s" "-L" + "--connect-timeout" "10" + "--max-time" (number-to-string calendar-sync-fetch-timeout) + "-o" temp-file + url) + :sentinel + (lambda (process event) + (when (memq (process-status process) '(exit signal)) + (let ((buf (process-buffer process)) + (success (and (eq (process-status process) 'exit) + (= (process-exit-status process) 0)))) + (when (buffer-live-p buf) + (unless success + (calendar-sync--log-silently "calendar-sync: Fetch error: curl failed: %s" + (string-trim event))) + (kill-buffer buf)) + (if success + (funcall callback temp-file) + (when (file-exists-p temp-file) + (delete-file temp-file)) + (funcall callback nil))))))) + (error + (calendar-sync--log-silently "calendar-sync: Fetch error: %s" (error-message-string err)) (funcall callback nil)))) (defun calendar-sync--write-file (content file) @@ -1225,6 +1280,92 @@ Creates parent directories if needed." (with-temp-file file (insert content))) +(defun calendar-sync--emacs-binary () + "Return the Emacs executable to use for calendar conversion workers." + (let ((candidate (expand-file-name invocation-name invocation-directory))) + (if (file-executable-p candidate) + candidate + invocation-name))) + +(defun calendar-sync--batch-convert-file (ics-file output-file past-months future-months user-emails) + "Convert ICS-FILE to Org format and write OUTPUT-FILE. +PAST-MONTHS, FUTURE-MONTHS, and USER-EMAILS mirror the interactive session's +calendar conversion settings. This is intended for noninteractive worker +processes, not direct interactive use." + (setq calendar-sync-past-months past-months + calendar-sync-future-months future-months + calendar-sync-user-emails user-emails) + (let* ((ics-content + (with-temp-buffer + (insert-file-contents ics-file) + (calendar-sync--normalize-line-endings (buffer-string)))) + (org-content (calendar-sync--parse-ics ics-content))) + (unless org-content + (error "calendar-sync: parse failed")) + (calendar-sync--write-file org-content output-file))) + +(defun calendar-sync--worker-command (ics-file output-file) + "Build the batch Emacs command that converts ICS-FILE to OUTPUT-FILE." + (let ((private-config-file + (make-temp-name (expand-file-name "calendar-sync-worker-config-" + temporary-file-directory))) + (state-file + (make-temp-name (expand-file-name "calendar-sync-worker-state-" + temporary-file-directory)))) + (list (calendar-sync--emacs-binary) + "--batch" + "--no-site-file" + "--no-site-lisp" + "--eval" (format "(setq load-prefer-newer t calendar-sync-auto-start nil calendar-sync-private-config-file %S calendar-sync--state-file %S)" + private-config-file state-file) + "-l" calendar-sync--module-file + "--eval" (format "(calendar-sync--batch-convert-file %S %S %S %S '%S)" + ics-file + output-file + calendar-sync-past-months + calendar-sync-future-months + calendar-sync-user-emails)))) + +(defun calendar-sync--convert-ics-file-async (ics-file output-file callback) + "Convert ICS-FILE to OUTPUT-FILE in a batch Emacs worker. +Calls CALLBACK as (CALLBACK SUCCESS ERROR-MESSAGE). Deletes ICS-FILE after the +worker exits." + (condition-case err + (let ((buffer (generate-new-buffer " *calendar-sync-worker*"))) + (make-process + :name "calendar-sync-worker" + :buffer buffer + :command (calendar-sync--worker-command ics-file output-file) + :sentinel + (lambda (process _event) + (when (memq (process-status process) '(exit signal)) + (let* ((buf (process-buffer process)) + (success (and (eq (process-status process) 'exit) + (= (process-exit-status process) 0))) + (error-message + (when (buffer-live-p buf) + (with-current-buffer buf + (string-trim (buffer-string)))))) + (when (file-exists-p ics-file) + (delete-file ics-file)) + (when (buffer-live-p buf) + (kill-buffer buf)) + (funcall callback success error-message)))))) + (error + (when (file-exists-p ics-file) + (delete-file ics-file)) + (funcall callback nil (error-message-string err))))) + +(defun calendar-sync--mark-sync-failed (name reason) + "Record failed sync state for calendar NAME with REASON." + (calendar-sync--set-calendar-state + name + (list :status 'error + :last-sync (plist-get (calendar-sync--get-calendar-state name) :last-sync) + :last-error reason)) + (calendar-sync--save-state) + (message "calendar-sync: [%s] Sync failed (see *Messages*)" name)) + ;;; Debug Logging (defun calendar-sync--load-private-config () @@ -1250,63 +1391,50 @@ Checks `cj/debug-modules' for symbol `calendar-sync' or t (all)." "Sync a single CALENDAR asynchronously. CALENDAR is a plist with :name, :url, and :file keys. Updates calendar state and saves to disk on completion. -Logs timing for each phase to *Messages* for performance diagnosis." +The fetch and conversion run in external processes so parsing and writing large +calendar files do not block the interactive Emacs thread." (let ((name (plist-get calendar :name)) (url (plist-get calendar :url)) (file (plist-get calendar :file)) (fetch-start (float-time))) - ;; Mark as syncing (calendar-sync--set-calendar-state name '(:status syncing)) - (cj/log-silently "calendar-sync: [%s] Syncing..." name) - (calendar-sync--fetch-ics + (calendar-sync--log-silently "calendar-sync: [%s] Syncing..." name) + (calendar-sync--fetch-ics-file url - (lambda (ics-content) + (lambda (ics-file) (let ((fetch-elapsed (- (float-time) fetch-start))) - (if (null ics-content) + (if (null ics-file) (progn - (cj/log-silently "calendar-sync: [%s] Fetch failed" name) - (calendar-sync--set-calendar-state - name - (list :status 'error - :last-sync (plist-get (calendar-sync--get-calendar-state name) :last-sync) - :last-error "Fetch failed")) - (calendar-sync--save-state) - (message "calendar-sync: [%s] Sync failed (see *Messages*)" name)) + (calendar-sync--log-silently "calendar-sync: [%s] Fetch failed" name) + (calendar-sync--mark-sync-failed name "Fetch failed")) (when (calendar-sync--debug-p) - (cj/log-silently "calendar-sync: [%s] Fetched %dKB in %.1fs" - name (/ (length ics-content) 1024) fetch-elapsed)) - (let* ((parse-start (float-time)) - (org-content (calendar-sync--parse-ics ics-content)) - (parse-elapsed (- (float-time) parse-start))) - (if (null org-content) - (progn - (cj/log-silently "calendar-sync: [%s] Parse failed (%.1fs)" name parse-elapsed) - (calendar-sync--set-calendar-state - name - (list :status 'error - :last-sync (plist-get (calendar-sync--get-calendar-state name) :last-sync) - :last-error "Parse failed")) - (calendar-sync--save-state) - (message "calendar-sync: [%s] Sync failed (see *Messages*)" name)) - (when (calendar-sync--debug-p) - (cj/log-silently "calendar-sync: [%s] Parsed in %.1fs" name parse-elapsed)) - (let ((write-start (float-time))) - (calendar-sync--write-file org-content file) - (when (calendar-sync--debug-p) - (cj/log-silently "calendar-sync: [%s] Wrote %s in %.2fs" - name (file-name-nondirectory file) - (- (float-time) write-start)))) - (calendar-sync--set-calendar-state - name - (list :status 'ok - :last-sync (current-time) - :last-error nil)) - (setq calendar-sync--last-timezone-offset - (calendar-sync--current-timezone-offset)) - (calendar-sync--save-state) - (let ((total-elapsed (- (float-time) fetch-start))) - (message "calendar-sync: [%s] Sync complete (%.1fs total) → %s" - name total-elapsed file)))))))))) + (calendar-sync--log-silently "calendar-sync: [%s] Fetched in %.1fs" + name fetch-elapsed)) + (calendar-sync--convert-ics-file-async + ics-file + file + (lambda (success error-message) + (if (not success) + (progn + (calendar-sync--log-silently "calendar-sync: [%s] Conversion failed: %s" + name error-message) + (calendar-sync--mark-sync-failed + name + (if (or (null error-message) + (string-empty-p error-message)) + "Conversion failed" + error-message))) + (calendar-sync--set-calendar-state + name + (list :status 'ok + :last-sync (current-time) + :last-error nil)) + (setq calendar-sync--last-timezone-offset + (calendar-sync--current-timezone-offset)) + (calendar-sync--save-state) + (let ((total-elapsed (- (float-time) fetch-start))) + (message "calendar-sync: [%s] Sync complete (%.1fs total) → %s" + name total-elapsed file))))))))))) (defun calendar-sync--require-calendars () "Return non-nil if calendars are configured, else warn and return nil." diff --git a/tests/test-calendar-sync-async-worker.el b/tests/test-calendar-sync-async-worker.el new file mode 100644 index 00000000..d5982d32 --- /dev/null +++ b/tests/test-calendar-sync-async-worker.el @@ -0,0 +1,154 @@ +;;; test-calendar-sync-async-worker.el --- Tests for async calendar conversion -*- lexical-binding: t; -*- + +;;; Commentary: +;; Regression tests for keeping calendar sync parse/write work off the main +;; Emacs thread. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'testutil-calendar-sync) +(require 'calendar-sync) + +(ert-deftest test-calendar-sync--worker-command-loads-module-without-init () + "The conversion worker should run batch Emacs without user init." + (let* ((calendar-sync--module-file "/tmp/calendar-sync.el") + (calendar-sync-past-months 2) + (calendar-sync-future-months 6) + (calendar-sync-user-emails '("me@example.test")) + (command (calendar-sync--worker-command "/tmp/input.ics" "/tmp/output.org"))) + (should (member "--batch" command)) + (should (member "--no-site-file" command)) + (should (member "--no-site-lisp" command)) + (should (member "-l" command)) + (should (member "/tmp/calendar-sync.el" command)) + (should (cl-some (lambda (arg) + (and (stringp arg) + (string-match-p "calendar-sync-auto-start nil" arg))) + command)) + (should (cl-some (lambda (arg) + (and (stringp arg) + (string-match-p "calendar-sync--batch-convert-file" arg) + (string-match-p "/tmp/input\\.ics" arg) + (string-match-p "/tmp/output\\.org" arg) + (string-match-p "'(\"me@example\\.test\")" arg))) + command)))) + +(ert-deftest test-calendar-sync--batch-convert-file-writes-org-output () + "The worker entry point should convert an ICS file and write Org output." + (let* ((input-file (make-temp-file "calendar-sync-worker-" nil ".ics")) + (output-file (make-temp-file "calendar-sync-worker-" nil ".org")) + (event (test-calendar-sync-make-vevent + "Worker Meeting" + (test-calendar-sync-time-tomorrow-at 9 0) + (test-calendar-sync-time-tomorrow-at 10 0))) + (ics (test-calendar-sync-make-ics event))) + (unwind-protect + (progn + (with-temp-file input-file + (insert ics)) + (delete-file output-file) + (calendar-sync--batch-convert-file input-file output-file 3 12 '("me@example.test")) + (should (file-exists-p output-file)) + (with-temp-buffer + (insert-file-contents output-file) + (should (string-match-p "\\* Worker Meeting" (buffer-string))))) + (when (file-exists-p input-file) + (delete-file input-file)) + (when (file-exists-p output-file) + (delete-file output-file))))) + +(ert-deftest test-calendar-sync--parse-ics-does-not-require-cj-log-silently () + "Worker parsing should not fail when the rest of the config is not loaded." + (let ((original-log-function + (when (fboundp 'cj/log-silently) + (symbol-function 'cj/log-silently)))) + (unwind-protect + (progn + (when (fboundp 'cj/log-silently) + (fmakunbound 'cj/log-silently)) + (should-not (calendar-sync--parse-ics "not valid ics"))) + (when original-log-function + (fset 'cj/log-silently original-log-function))))) + +(ert-deftest test-calendar-sync--sync-calendar-uses-worker-for-parse-and-write () + "Sync should fetch to a file and hand parse/write work to a worker process." + (let ((calendar '(:name "work" + :url "https://example.test/work.ics" + :file "/tmp/work.org")) + (calendar-sync--calendar-states (make-hash-table :test 'equal)) + (fetched-url nil) + (worker-input nil) + (worker-output nil) + (saved-state nil)) + (cl-letf (((symbol-function 'calendar-sync--fetch-ics-file) + (lambda (url callback) + (setq fetched-url url) + (funcall callback "/tmp/work.ics"))) + ((symbol-function 'calendar-sync--convert-ics-file-async) + (lambda (ics-file output-file callback) + (setq worker-input ics-file + worker-output output-file) + (funcall callback t ""))) + ((symbol-function 'calendar-sync--parse-ics) + (lambda (&rest _args) + (ert-fail "sync-calendar parsed ICS on the main thread"))) + ((symbol-function 'calendar-sync--write-file) + (lambda (&rest _args) + (ert-fail "sync-calendar wrote the Org file on the main thread"))) + ((symbol-function 'calendar-sync--save-state) + (lambda () + (setq saved-state t))) + ((symbol-function 'message) (lambda (&rest _args) nil))) + (calendar-sync--sync-calendar calendar)) + (should (string= "https://example.test/work.ics" fetched-url)) + (should (string= "/tmp/work.ics" worker-input)) + (should (string= "/tmp/work.org" worker-output)) + (should saved-state) + (should (eq 'ok (plist-get (calendar-sync--get-calendar-state "work") :status))))) + +(ert-deftest test-calendar-sync--sync-calendar-records-worker-failure () + "Worker conversion failures should be reflected in calendar state." + (let ((calendar '(:name "work" + :url "https://example.test/work.ics" + :file "/tmp/work.org")) + (calendar-sync--calendar-states (make-hash-table :test 'equal)) + (saved-state nil)) + (cl-letf (((symbol-function 'calendar-sync--fetch-ics-file) + (lambda (_url callback) + (funcall callback "/tmp/work.ics"))) + ((symbol-function 'calendar-sync--convert-ics-file-async) + (lambda (_ics-file _output-file callback) + (funcall callback nil "parse failed"))) + ((symbol-function 'calendar-sync--save-state) + (lambda () + (setq saved-state t))) + ((symbol-function 'message) (lambda (&rest _args) nil))) + (calendar-sync--sync-calendar calendar)) + (let ((state (calendar-sync--get-calendar-state "work"))) + (should saved-state) + (should (eq 'error (plist-get state :status))) + (should (string-match-p "parse failed" (plist-get state :last-error)))))) + +(ert-deftest test-calendar-sync--sync-calendar-handles-empty-worker-error () + "Worker failures without stderr should still produce a useful state error." + (let ((calendar '(:name "work" + :url "https://example.test/work.ics" + :file "/tmp/work.org")) + (calendar-sync--calendar-states (make-hash-table :test 'equal))) + (cl-letf (((symbol-function 'calendar-sync--fetch-ics-file) + (lambda (_url callback) + (funcall callback "/tmp/work.ics"))) + ((symbol-function 'calendar-sync--convert-ics-file-async) + (lambda (_ics-file _output-file callback) + (funcall callback nil nil))) + ((symbol-function 'calendar-sync--save-state) (lambda () nil)) + ((symbol-function 'message) (lambda (&rest _args) nil))) + (calendar-sync--sync-calendar calendar)) + (let ((state (calendar-sync--get-calendar-state "work"))) + (should (eq 'error (plist-get state :status))) + (should (string= "Conversion failed" (plist-get state :last-error)))))) + +(provide 'test-calendar-sync-async-worker) +;;; test-calendar-sync-async-worker.el ends here |