Переглянути джерело

Fix local-time and plump workarounds

Innocenty Enikeew 10 роки тому
батько
коміт
05e72b7cf9
3 змінених файлів з 36 додано та 3 видалено
  1. 0 2
      forecast.lisp
  2. 1 1
      rss.lisp
  3. 35 0
      utils.lisp

+ 0 - 2
forecast.lisp

@@ -19,8 +19,6 @@
       (declare (ignore e))
       (error "Timeout"))))
 
-(local-time:reread-timezone-repository :timezone-repository "/usr/share/zoneinfo/")
-
 (defvar *forecast-point-formats*
   '((:current . (:year "-" (:month 2) "-" (:day 2) " " (:hour 2) ":" (:min 2)))
     (:hour . ((:hour 2) ":" (:min 2)))

+ 1 - 1
rss.lisp

@@ -16,7 +16,7 @@
      nil)))
 
 (defun get-by-tag (node tag)
-  (nreverse (plump:get-elements-by-tag-name node tag)))
+  (nreverse (plump::get-elements-by-tag-name node tag)))
 
 (defun url-parse (url)
   (multiple-value-bind (body status headers uri stream)

+ 35 - 0
utils.lisp

@@ -80,3 +80,38 @@ is replaced with replacement."
       ((eq head cur)
        (nreverse (push (car cur) result)))
     (push (car cur) result)))
+
+
+;; Fix bug in local-time (following symlinks in /usr/share/zoneinfo/
+;; leads to bad cutoff)
+(in-package #:local-time)
+(defun reread-timezone-repository (&key (timezone-repository *default-timezone-repository-path*))
+  (check-type timezone-repository (or pathname string))
+  (multiple-value-bind (valid? error)
+      (ignore-errors
+        (truename timezone-repository)
+        t)
+    (unless valid?
+      (error "REREAD-TIMEZONE-REPOSITORY was called with invalid PROJECT-DIRECTORY (~A). The error is ~A."
+             timezone-repository error)))
+  (let* ((root-directory timezone-repository)
+         (cutoff-position (length (princ-to-string root-directory))))
+    (flet ((visitor (file)
+             (handler-case
+                 (let* ((full-name (subseq (princ-to-string file) cutoff-position))
+                        (name (pathname-name file))
+                        (timezone (%realize-timezone (make-timezone :path file :name name))))
+                   (setf (gethash full-name *location-name->timezone*) timezone)
+                   (map nil (lambda (subzone)
+                              (push timezone (gethash (subzone-abbrev subzone)
+                                                      *abbreviated-subzone-name->timezone-list*)))
+                        (timezone-subzones timezone)))
+               (invalid-timezone-file () nil))))
+      (setf *location-name->timezone* (make-hash-table :test 'equal))
+      (setf *abbreviated-subzone-name->timezone-list* (make-hash-table :test 'equal))
+      (cl-fad:walk-directory root-directory #'visitor :directories nil :follow-symlinks nil
+                             :test (lambda (file)
+                                     (not (find "Etc" (pathname-directory file) :test #'string=))))
+      (cl-fad:walk-directory (merge-pathnames "Etc/" root-directory) #'visitor :directories nil))))
+
+(local-time:reread-timezone-repository :timezone-repository "/usr/share/zoneinfo/")