1;;; bbdb-migrate.el --- migration functions for BBDB -*- lexical-binding: t -*- 2 3;; Copyright (C) 2010-2017 Free Software Foundation, Inc. 4 5;; This file is part of the Insidious Big Brother Database (aka BBDB), 6 7;; BBDB is free software: you can redistribute it and/or modify 8;; it under the terms of the GNU General Public License as published by 9;; the Free Software Foundation, either version 3 of the License, or 10;; (at your option) any later version. 11 12;; BBDB is distributed in the hope that it will be useful, 13;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15;; GNU General Public License for more details. 16 17;; You should have received a copy of the GNU General Public License 18;; along with BBDB. If not, see <http://www.gnu.org/licenses/>. 19 20;;; Commentary: 21;;; This file contains the migration functions for BBDB. 22;;; See the BBDB info manual for documentation. 23 24;; Changes in `bbdb-file-format': 25;; 3 Date format for `creation-date' and `timestamp' changed 26;; from "dd mmm yy" (ex: 25 Sep 97) to "yyyy-mm-dd" (ex: 1997-09-25). 27;; 4 Country field added. 28;; 5 Streets are lists. 29;; 6 Postcodes are plain strings. 30;; 7 New field `affix'. Organizations are a list. 31;; Xfields is always a list. 32;; (8 Skipped format in "official BBDB": Some BBDB users introduced 33;; an xfield uuid in their format 8. To bring them back, we jump 34;; straight from 7 to 9.) 35;; 9 New field uuid. Make `creation-date' and `timestamp' immutable fields. 36 37 38;;; Code: 39 40(require 'bbdb) 41 42;;; Migrating the BBDB 43 44(defvar bbdb-migrate-uuid-xfield 'uuid 45 "Xfield holding a uuid in file format 8.") 46 47;;;###autoload 48(defun bbdb-migrate (records old) 49 "Migrate RECORDS from format OLD to `bbdb-file-format'." 50 ;; Some BBDB files were corrupted by random outer layers of 51 ;; parentheses surrounding the actual correct data. We attempt to 52 ;; compensate for this. 53 (while (and (consp records) 54 (listp (car records)) 55 (null (cdr records))) 56 (setq records (car records))) 57 58 ;; `bbdb-migrate-lambda' uses the usual functions to access and set 59 ;; the fields of a record. So if a new record format changes 60 ;; the set of fields, we need to make these changes first. 61 62 ;; Format 7: Add new field `affix'. 63 (if (< old 7) 64 (let (new-records) 65 (dolist (record records) 66 (push (vector (elt record 0) (elt record 1) nil 67 (elt record 2) (elt record 3) (elt record 4) 68 (elt record 5) (elt record 6) (elt record 7) 69 (elt record 8)) 70 new-records)) 71 (setq records (nreverse new-records)))) 72 73 ;; Format 9: New field `uuid'. 74 ;; Make `creation-date' and `timestamp' immutable fields. 75 (if (< old 9) 76 (let (new-records) 77 (dolist (record records) 78 (let ((uuid (or (cdr (assq bbdb-migrate-uuid-xfield (elt record 8))) 79 (bbdb-uuid))) 80 (creation-date (or (cdr (assq 'creation-date (elt record 8))) 81 (format-time-string bbdb-time-stamp-format nil t))) 82 (timestamp (or (cdr (assq 'timestamp (elt record 8))) 83 (format-time-string bbdb-time-stamp-format nil t)))) 84 (push (vector (elt record 0) (elt record 1) (elt record 2) 85 (elt record 3) (elt record 4) (elt record 5) 86 (elt record 6) (elt record 7) 87 (let ((xfields (elt record 8))) 88 (dolist (elt '(uuid creation-date timestamp)) 89 (setq xfields (assq-delete-all elt xfields))) 90 xfields) 91 uuid creation-date timestamp 92 (elt record 9)) 93 new-records))) 94 (setq records (nreverse new-records)))) 95 96 (mapc (bbdb-migrate-lambda old) records) 97 records) 98 99(defconst bbdb-migrate-alist 100 '((3 (bbdb-record-xfields bbdb-record-set-xfields 101 bbdb-migrate-dates)) 102 (4 (bbdb-record-address bbdb-record-set-address 103 bbdb-migrate-add-country)) 104 (5 (bbdb-record-address bbdb-record-set-address 105 bbdb-migrate-streets-to-list)) 106 (6 (bbdb-record-address bbdb-record-set-address 107 bbdb-migrate-postcode-to-string)) 108 (7 (bbdb-record-xfields bbdb-record-set-xfields 109 bbdb-migrate-xfields-to-list) 110 (bbdb-record-organization bbdb-record-set-organization 111 bbdb-migrate-organization-to-list))) 112 ;; Formats 8 and 9: do nothing 113 "Alist (VERSION . CHANGES). 114CHANGES is a list with elements (GET SET FUNCTION) that expands 115to action (SET record (FUNCTION (GET record))).") 116 117(defun bbdb-migrate-lambda (old) 118 "Return the function to migrate from OLD to `bbdb-file-format'. 119The manipulations are defined by `bbdb-migrate-alist'." 120 (let (spec) 121 (while (<= old bbdb-file-format) 122 (setq spec (append spec (cdr (assoc old bbdb-migrate-alist))) 123 old (1+ old))) 124 `(lambda (record) 125 ,@(mapcar (lambda (change) 126 ;; (SET record (FUNCTION (GET record))) 127 `(,(nth 1 change) record ; SET 128 (,(nth 2 change) ; FUNCTION 129 (,(nth 0 change) record)))) ; GET 130 spec) 131 record))) 132 133(defun bbdb-migrate-postcode-to-string (addresses) 134 "Make all postcodes plain strings. 135This uses the code that used to be in `bbdb-address-postcode'." 136 ;; apply the function to all addresses in the list and return a 137 ;; modified list of addresses 138 (mapcar (lambda (address) 139 (let ((postcode (bbdb-address-postcode address))) 140 (bbdb-address-set-postcode 141 address 142 (cond ((stringp postcode) 143 postcode) 144 ;; nil or zero 145 ((or (zerop postcode) 146 (null postcode)) 147 "") 148 ;; a number 149 ((numberp postcode) 150 (format "%d" postcode)) 151 ;; list with two strings 152 ((and (stringp (nth 0 postcode)) 153 (stringp (nth 1 postcode))) 154 ;; the second string starts with 4 digits 155 (if (string-match "^[0-9][0-9][0-9][0-9]" 156 (nth 1 postcode)) 157 (format "%s-%s" (nth 0 postcode) (nth 1 postcode)) 158 ;; ("abc" "efg") 159 (format "%s %s" (nth 0 postcode) (nth 1 postcode)))) 160 ;; list with two numbers 161 ((and (integerp (nth 0 postcode)) 162 (integerp (nth 1 postcode))) 163 (format "%05d-%04d" (nth 0 postcode) (nth 1 postcode))) 164 ;; list with a string and a number 165 ((and (stringp (nth 0 postcode)) 166 (integerp (nth 1 postcode))) 167 (format "%s-%d" (nth 0 postcode) (nth 1 postcode))) 168 ;; ("SE" (123 45)) 169 ((and (stringp (nth 0 postcode)) 170 (integerp (nth 0 (nth 1 postcode))) 171 (integerp (nth 1 (nth 1 postcode)))) 172 (format "%s-%d %d" (nth 0 postcode) (nth 0 (nth 1 postcode)) 173 (nth 1 (nth 1 postcode)))) 174 ;; last possibility 175 (t (format "%s" postcode))))) 176 address) 177 addresses)) 178 179(defun bbdb-migrate-dates (xfields) 180 "Change date formats. 181Formats are changed in timestamp and creation-date fields from 182\"dd mmm yy\" to \"yyyy-mm-dd\"." 183 (unless (stringp xfields) 184 (mapc (lambda (xfield) 185 (when (memq (car xfield) '(creation-date timestamp)) 186 (bbdb-migrate-date xfield))) 187 xfields) 188 xfields)) 189 190(defun bbdb-migrate-date (field) 191 "Convert date field FIELD from \"dd mmm yy\" to \"yyyy-mm-dd\"." 192 (let* ((date (cdr field)) 193 (parsed (timezone-parse-date (concat date " 00:00:00")))) 194 ;; If `timezone-parse-date' cannot make sense of its arg DATE 195 ;; it returns ["0" "0" "0" "0" nil]. 196 (if (equal parsed ["0" "0" "0" "0" nil]) 197 (setq parsed (timezone-parse-date date))) 198 (when (equal parsed ["0" "0" "0" "0" nil]) 199 (cond ((string-match 200 "^\\([0-9]\\{4\\}\\)[-/]\\([ 0-9]?[0-9]\\)[-/]\\([ 0-9]?[0-9]\\)" date) 201 (setq parsed (vector (match-string 1 date) (match-string 2 date) 202 (match-string 3 date)))) 203 ((string-match 204 "^\\([ 0-9]?[0-9]\\)[-/]\\([ 0-9]?[0-9]\\)[-/]\\([0-9]\\{4\\}\\)" date) 205 (setq parsed (vector (match-string 3 date) (match-string 1 date) 206 (match-string 2 date)))))) 207 208 ;; We need numbers for the following sanity check 209 (dotimes (i 3) 210 (if (stringp (aref parsed i)) 211 (aset parsed i (string-to-number (aref parsed i))))) 212 213 ;; Sanity check 214 (if (and (< 0 (aref parsed 0)) 215 (< 0 (aref parsed 1)) (< (aref parsed 1) 13) 216 (< 0 (aref parsed 2)) 217 (<= (aref parsed 2) 218 (timezone-last-day-of-month (aref parsed 1) (aref parsed 0)))) 219 (setcdr field (format "%04d-%02d-%02d" (aref parsed 0) 220 (aref parsed 1) (aref parsed 2))) 221 (error "BBDB cannot parse %s header value %S for upgrade" 222 field date)))) 223 224(defun bbdb-migrate-add-country (addrl) 225 "Add a country field to each address in the address list." 226 (mapcar (lambda (address) (vconcat address [bbdb-default-country])) addrl)) 227 228(defun bbdb-migrate-streets-to-list (addrl) 229 "Convert the streets to a list." 230 (mapcar (lambda (address) 231 (vector (aref address 0) ; key 232 (delq nil (delete "" ; nuke empties 233 (list (aref address 1) ; street1 234 (aref address 2) ; street2 235 (aref address 3))));street3 236 (aref address 4) ; city 237 (aref address 5) ; state 238 (aref address 6) ; postcode 239 (aref address 7))) ; country 240 addrl)) 241 242(defun bbdb-migrate-xfields-to-list (xfields) 243 "Migrate XFIELDS to list." 244 (if (stringp xfields) 245 `((notes . ,xfields)) 246 xfields)) 247 248(defun bbdb-migrate-organization-to-list (organization) 249 "Migrate ORGANIZATION to list." 250 (if (stringp organization) 251 (bbdb-split 'organization organization) 252 organization)) 253 254;;;###autoload 255(defun bbdb-undocumented-variables (&optional name-space message) 256 "Return list of undocumented variables in NAME-SPACE. 257NAME-SPACE defaults to \"bbdb-\". Use a prefix arg to specify NAME-SPACE 258interactively. If MESSAGE is non-nil (as in interactive calls) display 259the list in the message area. 260 261This command may come handy to identify BBDB variables in your init file 262that are not used anymore by the current version of BBDB. Yet this fails 263for outdated BBDB variables that are set via your personal `custom-file'." 264 (interactive (list (if current-prefix-arg 265 (read-string "Name space: ")) t)) 266 (let ((re (concat "\\`" (or name-space "bbdb-"))) list) 267 (mapatoms (lambda (vv) 268 (if (and (boundp vv) 269 (string-match re (symbol-name vv)) 270 (not (get vv 'variable-documentation)) 271 (not (get vv 'byte-obsolete-variable))) 272 (push vv list)))) 273 (if message 274 (if list 275 (apply 'message (concat "Undocumented variables: " 276 (mapconcat (lambda (_m) "%s") list " ")) list) 277 (message "No undocumented variables `%s...'" name-space))) 278 list)) 279 280(provide 'bbdb-migrate) 281 282;;; bbdb-migrate.el ends here 283