diff options
| -rw-r--r-- | mumi/xapian.scm | 46 |
1 files changed, 46 insertions, 0 deletions
diff --git a/mumi/xapian.scm b/mumi/xapian.scm index f1ad7a4..b00e8ee 100644 --- a/mumi/xapian.scm +++ b/mumi/xapian.scm @@ -135,6 +135,52 @@ messages and index their contents in the Xapian database at DBPATH." (unless (null? rest) (loop rest)))))) +(define (sanitize-date-range token) + (define now (current-time)) + (define (days n) + (make-time time-duration 0 (* 60 60 24 n))) + (define (range-boundary->date-string boundary*) + (define boundary (string-delete #\- boundary*)) + (cond + ((string->number boundary) boundary) + (else + (let ((date (match boundary + ((or "now" "today") now) + ("yesterday" (subtract-duration now (days 1))) + (_ + (call-with-values + (lambda () (span char-numeric? (string->list boundary))) + (lambda (pre post) + (let ((n (string->number (apply string pre))) + (unit (apply string post))) + (and n + (subtract-duration + now + (match unit + ((or "d" "day" "days") + (days n)) + ((or "w" "week" "weeks") + (days (* n 7))) + ((or "m" "month" "months") + (days (* n 30))) + ((or "y" "year" "years") + (days (* n 365))))))))))))) + (and date + (date->string (time-utc->date date) "~Y~m~d")))))) + (if (or (string-prefix? "date:" token) + (string-prefix? "mdate:" token)) + (match (string-split token (char-set #\: #\.)) + ((prefix begin sep end) + (let ((begin* (range-boundary->date-string begin)) + (end* (if (or (not end) (string-null? end)) "" + (or (range-boundary->date-string end) "")))) + (if begin* + (string-append prefix ":" begin* ".." end*) + (string-append begin " " end)))) + ;; Swallow invalid tokens silently to avoid crashing Xapian + (invalid (pk invalid ""))) + token)) + (define* (parse-query* querystring #:key stemmer stemming-strategy (prefixes '())) (let ((queryparser (new-QueryParser)) (date-range-processor (new-DateRangeProcessor 0 "date:" 0)) |