diff options
Diffstat (limited to '')
| -rw-r--r-- | lisp/bbdb/bbdb-migrate.el | 282 |
1 files changed, 282 insertions, 0 deletions
diff --git a/lisp/bbdb/bbdb-migrate.el b/lisp/bbdb/bbdb-migrate.el new file mode 100644 index 0000000..7bce4da --- /dev/null +++ b/lisp/bbdb/bbdb-migrate.el @@ -0,0 +1,282 @@ +;;; bbdb-migrate.el --- migration functions for BBDB -*- lexical-binding: t -*- + +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. + +;; This file is part of the Insidious Big Brother Database (aka BBDB), + +;; BBDB is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; BBDB is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with BBDB. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;;; This file contains the migration functions for BBDB. +;;; See the BBDB info manual for documentation. + +;; Changes in `bbdb-file-format': +;; 3 Date format for `creation-date' and `timestamp' changed +;; from "dd mmm yy" (ex: 25 Sep 97) to "yyyy-mm-dd" (ex: 1997-09-25). +;; 4 Country field added. +;; 5 Streets are lists. +;; 6 Postcodes are plain strings. +;; 7 New field `affix'. Organizations are a list. +;; Xfields is always a list. +;; (8 Skipped format in "official BBDB": Some BBDB users introduced +;; an xfield uuid in their format 8. To bring them back, we jump +;; straight from 7 to 9.) +;; 9 New field uuid. Make `creation-date' and `timestamp' immutable fields. + + +;;; Code: + +(require 'bbdb) + +;;; Migrating the BBDB + +(defvar bbdb-migrate-uuid-xfield 'uuid + "Xfield holding a uuid in file format 8.") + +;;;###autoload +(defun bbdb-migrate (records old) + "Migrate RECORDS from format OLD to `bbdb-file-format'." + ;; Some BBDB files were corrupted by random outer layers of + ;; parentheses surrounding the actual correct data. We attempt to + ;; compensate for this. + (while (and (consp records) + (listp (car records)) + (null (cdr records))) + (setq records (car records))) + + ;; `bbdb-migrate-lambda' uses the usual functions to access and set + ;; the fields of a record. So if a new record format changes + ;; the set of fields, we need to make these changes first. + + ;; Format 7: Add new field `affix'. + (if (< old 7) + (let (new-records) + (dolist (record records) + (push (vector (elt record 0) (elt record 1) nil + (elt record 2) (elt record 3) (elt record 4) + (elt record 5) (elt record 6) (elt record 7) + (elt record 8)) + new-records)) + (setq records (nreverse new-records)))) + + ;; Format 9: New field `uuid'. + ;; Make `creation-date' and `timestamp' immutable fields. + (if (< old 9) + (let (new-records) + (dolist (record records) + (let ((uuid (or (cdr (assq bbdb-migrate-uuid-xfield (elt record 8))) + (bbdb-uuid))) + (creation-date (or (cdr (assq 'creation-date (elt record 8))) + (format-time-string bbdb-time-stamp-format nil t))) + (timestamp (or (cdr (assq 'timestamp (elt record 8))) + (format-time-string bbdb-time-stamp-format nil t)))) + (push (vector (elt record 0) (elt record 1) (elt record 2) + (elt record 3) (elt record 4) (elt record 5) + (elt record 6) (elt record 7) + (let ((xfields (elt record 8))) + (dolist (elt '(uuid creation-date timestamp)) + (setq xfields (assq-delete-all elt xfields))) + xfields) + uuid creation-date timestamp + (elt record 9)) + new-records))) + (setq records (nreverse new-records)))) + + (mapc (bbdb-migrate-lambda old) records) + records) + +(defconst bbdb-migrate-alist + '((3 (bbdb-record-xfields bbdb-record-set-xfields + bbdb-migrate-dates)) + (4 (bbdb-record-address bbdb-record-set-address + bbdb-migrate-add-country)) + (5 (bbdb-record-address bbdb-record-set-address + bbdb-migrate-streets-to-list)) + (6 (bbdb-record-address bbdb-record-set-address + bbdb-migrate-postcode-to-string)) + (7 (bbdb-record-xfields bbdb-record-set-xfields + bbdb-migrate-xfields-to-list) + (bbdb-record-organization bbdb-record-set-organization + bbdb-migrate-organization-to-list))) + ;; Formats 8 and 9: do nothing + "Alist (VERSION . CHANGES). +CHANGES is a list with elements (GET SET FUNCTION) that expands +to action (SET record (FUNCTION (GET record))).") + +(defun bbdb-migrate-lambda (old) + "Return the function to migrate from OLD to `bbdb-file-format'. +The manipulations are defined by `bbdb-migrate-alist'." + (let (spec) + (while (<= old bbdb-file-format) + (setq spec (append spec (cdr (assoc old bbdb-migrate-alist))) + old (1+ old))) + `(lambda (record) + ,@(mapcar (lambda (change) + ;; (SET record (FUNCTION (GET record))) + `(,(nth 1 change) record ; SET + (,(nth 2 change) ; FUNCTION + (,(nth 0 change) record)))) ; GET + spec) + record))) + +(defun bbdb-migrate-postcode-to-string (addresses) + "Make all postcodes plain strings. +This uses the code that used to be in `bbdb-address-postcode'." + ;; apply the function to all addresses in the list and return a + ;; modified list of addresses + (mapcar (lambda (address) + (let ((postcode (bbdb-address-postcode address))) + (bbdb-address-set-postcode + address + (cond ((stringp postcode) + postcode) + ;; nil or zero + ((or (zerop postcode) + (null postcode)) + "") + ;; a number + ((numberp postcode) + (format "%d" postcode)) + ;; list with two strings + ((and (stringp (nth 0 postcode)) + (stringp (nth 1 postcode))) + ;; the second string starts with 4 digits + (if (string-match "^[0-9][0-9][0-9][0-9]" + (nth 1 postcode)) + (format "%s-%s" (nth 0 postcode) (nth 1 postcode)) + ;; ("abc" "efg") + (format "%s %s" (nth 0 postcode) (nth 1 postcode)))) + ;; list with two numbers + ((and (integerp (nth 0 postcode)) + (integerp (nth 1 postcode))) + (format "%05d-%04d" (nth 0 postcode) (nth 1 postcode))) + ;; list with a string and a number + ((and (stringp (nth 0 postcode)) + (integerp (nth 1 postcode))) + (format "%s-%d" (nth 0 postcode) (nth 1 postcode))) + ;; ("SE" (123 45)) + ((and (stringp (nth 0 postcode)) + (integerp (nth 0 (nth 1 postcode))) + (integerp (nth 1 (nth 1 postcode)))) + (format "%s-%d %d" (nth 0 postcode) (nth 0 (nth 1 postcode)) + (nth 1 (nth 1 postcode)))) + ;; last possibility + (t (format "%s" postcode))))) + address) + addresses)) + +(defun bbdb-migrate-dates (xfields) + "Change date formats. +Formats are changed in timestamp and creation-date fields from +\"dd mmm yy\" to \"yyyy-mm-dd\"." + (unless (stringp xfields) + (mapc (lambda (xfield) + (when (memq (car xfield) '(creation-date timestamp)) + (bbdb-migrate-date xfield))) + xfields) + xfields)) + +(defun bbdb-migrate-date (field) + "Convert date field FIELD from \"dd mmm yy\" to \"yyyy-mm-dd\"." + (let* ((date (cdr field)) + (parsed (timezone-parse-date (concat date " 00:00:00")))) + ;; If `timezone-parse-date' cannot make sense of its arg DATE + ;; it returns ["0" "0" "0" "0" nil]. + (if (equal parsed ["0" "0" "0" "0" nil]) + (setq parsed (timezone-parse-date date))) + (when (equal parsed ["0" "0" "0" "0" nil]) + (cond ((string-match + "^\\([0-9]\\{4\\}\\)[-/]\\([ 0-9]?[0-9]\\)[-/]\\([ 0-9]?[0-9]\\)" date) + (setq parsed (vector (match-string 1 date) (match-string 2 date) + (match-string 3 date)))) + ((string-match + "^\\([ 0-9]?[0-9]\\)[-/]\\([ 0-9]?[0-9]\\)[-/]\\([0-9]\\{4\\}\\)" date) + (setq parsed (vector (match-string 3 date) (match-string 1 date) + (match-string 2 date)))))) + + ;; We need numbers for the following sanity check + (dotimes (i 3) + (if (stringp (aref parsed i)) + (aset parsed i (string-to-number (aref parsed i))))) + + ;; Sanity check + (if (and (< 0 (aref parsed 0)) + (< 0 (aref parsed 1)) (< (aref parsed 1) 13) + (< 0 (aref parsed 2)) + (<= (aref parsed 2) + (timezone-last-day-of-month (aref parsed 1) (aref parsed 0)))) + (setcdr field (format "%04d-%02d-%02d" (aref parsed 0) + (aref parsed 1) (aref parsed 2))) + (error "BBDB cannot parse %s header value %S for upgrade" + field date)))) + +(defun bbdb-migrate-add-country (addrl) + "Add a country field to each address in the address list." + (mapcar (lambda (address) (vconcat address [bbdb-default-country])) addrl)) + +(defun bbdb-migrate-streets-to-list (addrl) + "Convert the streets to a list." + (mapcar (lambda (address) + (vector (aref address 0) ; key + (delq nil (delete "" ; nuke empties + (list (aref address 1) ; street1 + (aref address 2) ; street2 + (aref address 3))));street3 + (aref address 4) ; city + (aref address 5) ; state + (aref address 6) ; postcode + (aref address 7))) ; country + addrl)) + +(defun bbdb-migrate-xfields-to-list (xfields) + "Migrate XFIELDS to list." + (if (stringp xfields) + `((notes . ,xfields)) + xfields)) + +(defun bbdb-migrate-organization-to-list (organization) + "Migrate ORGANIZATION to list." + (if (stringp organization) + (bbdb-split 'organization organization) + organization)) + +;;;###autoload +(defun bbdb-undocumented-variables (&optional name-space message) + "Return list of undocumented variables in NAME-SPACE. +NAME-SPACE defaults to \"bbdb-\". Use a prefix arg to specify NAME-SPACE +interactively. If MESSAGE is non-nil (as in interactive calls) display +the list in the message area. + +This command may come handy to identify BBDB variables in your init file +that are not used anymore by the current version of BBDB. Yet this fails +for outdated BBDB variables that are set via your personal `custom-file'." + (interactive (list (if current-prefix-arg + (read-string "Name space: ")) t)) + (let ((re (concat "\\`" (or name-space "bbdb-"))) list) + (mapatoms (lambda (vv) + (if (and (boundp vv) + (string-match re (symbol-name vv)) + (not (get vv 'variable-documentation)) + (not (get vv 'byte-obsolete-variable))) + (push vv list)))) + (if message + (if list + (apply 'message (concat "Undocumented variables: " + (mapconcat (lambda (_m) "%s") list " ")) list) + (message "No undocumented variables `%s...'" name-space))) + list)) + +(provide 'bbdb-migrate) + +;;; bbdb-migrate.el ends here |