1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
|
;;; bbdb-migrate.el --- migration functions for BBDB -*- lexical-binding:t -*-
;; Copyright (C) 2010-2022 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 'cl-lib)
(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-migrate-dates))
(4 (bbdb-record-address bbdb-migrate-add-country))
(5 (bbdb-record-address bbdb-migrate-streets-to-list))
(6 (bbdb-record-address bbdb-migrate-postcode-to-string))
(7 (bbdb-record-xfields bbdb-migrate-xfields-to-list)
(bbdb-record-organization bbdb-migrate-organization-to-list)))
;; Formats 8 and 9: do nothing
"Alist (VERSION . CHANGES).
CHANGES is a list with elements (GETTER FUNCTION) that expands
to action (setf (GETTER record) (FUNCTION (GETTER 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)))
(eval
`(lambda (record)
,@(mapcar (lambda (change)
(pcase-let ((`(,getter ,migrate-function) change))
;; (SET record (FUNCTION (GET record)))
`(cl-callf ,migrate-function (,getter record))))
spec)
record)
'lexical)))
(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)))
(setf (bbdb-address-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
|
