lispdoc: implemented the whole URI syntax; updated URIs in all docstrings to be writt...
[com-informatimago:com-informatimago.git] / common-lisp / bank / iban.lisp
1 ;;;; -*- coding:utf-8 -*-
2 ;;;;****************************************************************************
3 ;;;;FILE:               iban.lisp
4 ;;;;LANGUAGE:           Common-Lisp
5 ;;;;SYSTEM:             Common-Lisp
6 ;;;;USER-INTERFACE:     NONE
7 ;;;;DESCRIPTION
8 ;;;;    
9 ;;;;    See defpackage documentation string.
10 ;;;;
11 ;;;;AUTHORS
12 ;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
13 ;;;;MODIFICATIONS
14 ;;;;    2012-11-29 <PJB> Added a PRINT-OBJECT method, corrected ERROR calls,
15 ;;;;                     added examples to the package comment.
16 ;;;;    2004-10-10 <PJB> Created.
17 ;;;;BUGS
18 ;;;;    The verification of the country code accepts all existing countries
19 ;;;;    as defined by iso-3166.  Some of these country code are not used
20 ;;;;    (GP --> FR for example).  So an incorrect use of GP is not detected.
21 ;;;;LEGAL
22 ;;;;    AGPL3
23 ;;;;    
24 ;;;;    Copyright Pascal J. Bourguignon 1994 - 2012
25 ;;;;    
26 ;;;;    This program is free software: you can redistribute it and/or modify
27 ;;;;    it under the terms of the GNU Affero General Public License as published by
28 ;;;;    the Free Software Foundation, either version 3 of the License, or
29 ;;;;    (at your option) any later version.
30 ;;;;    
31 ;;;;    This program is distributed in the hope that it will be useful,
32 ;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
33 ;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
34 ;;;;    GNU Affero General Public License for more details.
35 ;;;;    
36 ;;;;    You should have received a copy of the GNU Affero General Public License
37 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>
38 ;;;;****************************************************************************
39
40 (in-package "COMMON-LISP-USER")
41 (defpackage "COM.INFORMATIMAGO.COMMON-LISP.BANK.IBAN"
42   (:use "COMMON-LISP"
43         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY"
44         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST"
45         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
46         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.ISO3166")
47   (:export "GET-AND-CHECK-ALPHANUM" "COMPUTE-IBAN-KEY" "CHECK-IBAN-KEY"
48            "GET-IBAN" "GET-KEY" "GET-COUNTRY-CODE" "SET-IBAN" 
49            "CHECK-COUNTRY" "BASIC-FORM" "IBAN" "IBAN-ERROR")
50   (:documentation "
51 This class is an Internationnal Bank Account Number, 
52 according to the European standard:
53 IBAN Format: <http://www.ecbs.org/iban/iban.htm>
54
55
56 To create find the IBAN given an account number with a country-code:
57
58    (make-instance 'iban
59       :basic-form (remove #\\space (format nil \"~2A00~A\" country-code account)))
60
61 this will compute the IBAN key, and print the IBAN instance.
62
63 To get the IBAN as a string with groups separated by spaces:
64
65    (com.informatimago.common-lisp.bank.iban:get-iban  iban  :with-spaces t)
66
67
68
69 License:
70
71     AGPL3
72     
73     Copyright Pascal J. Bourguignon 1994 - 2012
74     
75     This program is free software: you can redistribute it and/or modify
76     it under the terms of the GNU Affero General Public License as published by
77     the Free Software Foundation, either version 3 of the License, or
78     (at your option) any later version.
79     
80     This program is distributed in the hope that it will be useful,
81     but WITHOUT ANY WARRANTY; without even the implied warranty of
82     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
83     GNU Affero General Public License for more details.
84     
85     You should have received a copy of the GNU Affero General Public License
86     along with this program.  If not, see <http://www.gnu.org/licenses/>
87 "))
88 (in-package "COM.INFORMATIMAGO.COMMON-LISP.BANK.IBAN")
89
90
91
92
93
94
95 (defgeneric basic-form (iban)
96   (:documentation "RETURN: The basic form of the IBAN."))
97
98 (defgeneric get-and-check-alphanum (self string &optional length)
99   (:documentation "Check that STRING contains only alphanumeric character valid in an IBAN."))
100
101 (defgeneric check-country (self)
102   (:documentation "
103 DO:     Checks the country code in the basic-form, 
104         and raises an error if not valid.
105 RAISE:  IBAN-ERROR 
106 RETURN: SELF
107 "))
108
109 (defgeneric get-country-code (self)
110   (:documentation   "
111 RETURN: The country code in the IBAN.
112 "))
113
114 (defgeneric get-key (self)
115   (:documentation   "
116 RETURN: The computed key of the IBAN.
117 "))
118
119 (defgeneric get-iban (self &key with-spaces)
120   (:documentation   "
121 RETURN: The IBAN as a string, with spaces inserted when WITH-SPACES is
122         true, else in basic form.
123 "))
124
125 (defgeneric set-iban (self iban &key with-key)
126   (:documentation  "
127 DO:     Change the IBAN. If WITH-KEY is true then the IBAN key is checked
128         and an error raised if it is not valid, else the IBAN key is
129         computed and substituted.
130 RETURN: SELF
131 SIGNAL: An IBAN-ERROR when with-key and the key in the IBAN is incorrect.
132 "))
133
134
135
136 (define-condition iban-error (simple-error)
137   ()
138   (:documentation "An IBAN error."))
139
140
141 (defclass iban ()
142   ((basic-form
143     :reader basic-form
144     :initform "FR00000000000000000000000"
145     :initarg :basic-form
146     :type string
147     :documentation "The basic form of the IBAN."))
148   (:documentation "The Internationnal Bank Account Number class."))
149
150
151 (defmethod initialize-instance ((self iban) &rest args)
152   (declare (ignore args))
153   (call-next-method)
154   (when (basic-form  self) 
155     (set-iban self (basic-form  self)))
156   self)
157
158
159 (defmethod print-object ((self iban) stream)
160   (print-unreadable-object (self stream :identity t :type t)
161     (princ (basic-form self) stream))
162   self)
163
164
165 (defmethod get-country-code ((self iban))
166   "
167 RETURN: The country code in the IBAN.
168 "
169   (subseq (basic-form self) 0 2))
170
171
172 (defmethod get-key ((self iban))
173   "
174 RETURN: The computed key of the IBAN.
175 "
176   (subseq (slot-value self 'basic-form) 2 4))
177
178
179 (defmethod get-iban ((self iban) &key (with-spaces nil))
180   "
181 RETURN: The IBAN, with spaces inserted when WITH-SPACES is true, 
182         else in basic form.
183 "
184   (if with-spaces
185       (do ((iban (basic-form self))
186            (res '())
187            (i 0 (+ i 4)))
188           ((>= (+ i 4) (length iban))
189            (progn (push (subseq iban i) res)
190                   (apply (function concatenate) 'string (nreverse res))))
191         (push (subseq iban i (+ i 4)) res)
192         (push " " res))
193       (copy-seq (basic-form self))))
194
195
196
197 ;;     We test and convert to upper case letters, because
198 ;;     the RIB and IBAN may contain only the following characters:
199 ;;         0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ 
200
201
202 (defparameter +alphabet-from+
203   "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")
204
205
206 (defmethod get-and-check-alphanum ((self iban) string &optional length)
207   (when (and length (/= length (length string)))
208     (error 'iban-error
209            :format-control "For IBAN ~S:~%   Bad length,  expected ~D, got ~D: ~S" 
210            :format-arguments (list self length (length string) string)))
211   (map 'string (lambda (ch) 
212                  (let ((index (position ch +alphabet-from+)))
213                    (unless index 
214                      (error 'iban-error
215                             :format-control "For IBAN ~S:~%    Bad character '~C' in ~S, ~
216                               should be alphanumeric."
217                             :format-arguments (list self ch string)))
218                    (aref +alphabet-from+ (if (< index 36) index (- index 26)))))
219        string))
220
221
222 (defun country-codes ()
223   "Returns a list of 2-letter country codes."
224   (mapcar (function first)
225           (get-countries :only-existing t)))
226
227 (defparameter *country-codes* (country-codes)
228   "List of 2-letter country codes.")
229
230
231 (defmethod check-country ((self iban))
232   "
233 DO:     Checks the country code in the basic-form, 
234         and raises an error if not valid.
235 RAISE:  IBAN-ERROR 
236 RETURN: SELF
237 "
238   (let ((cc (get-country-code self)))
239     (unless (member cc *country-codes* :test (function string-equal))
240       (error 'iban-error :format-control "For IBAN ~S:~%   Bad country code: ~S"
241              :format-arguments (list self cc))))
242   self)
243
244
245 (defun check-iban-key (iban)
246   "
247 DO:         Check the IBAN KEY
248             The IBAN string must be in basic format,
249             all non alphanumeric characters removed.
250             0- move the first four characters of the IBAN to the end.
251             1- convert the letters into numerics.
252             2- apply MOD 97-10 (ISO 7064) : remainder of n by 97 must be 1
253             3- return T when the IBAN key checks.
254 RETURN: Whether the IBAN key checks.
255 "
256   (= 1 (mod
257         (loop
258           :for ch :across (concatenate 'string (subseq iban 4) (subseq iban 0 4))
259           :with n = 0
260           :do (setf n (+ (* (if (alpha-char-p ch) 100 10) n)
261                          (parse-integer (string ch) :radix 36 :junk-allowed nil)))
262           :finally (return n)) 97)))
263
264
265 (defun compute-iban-key (country account)
266   "
267 DO:         Compute the IBAN key for the given ACCOUNT.
268             ACCOUNT must be in basic format, all non alphanumeric characters removed.
269             0- create artificial IBAN with 00 check sum.
270             1- move the first four characters of the IBAN to the end.
271             2- convert the letters into numerics.
272             3- apply MOD 97-10 (ISO 7064): check sum is 98 - n mod 97.
273             4- return the complete IBAN.
274 RETURN: The new complete IBANA.
275 "
276   (format nil "~2A~2,'0D~A" 
277           country
278           (- 98 (mod (loop
279                         for ch across (concatenate 'string  account country "00")
280                         with n = 0
281                         do (setf n (+ (* (if (alpha-char-p ch) 100 10) n)
282                                       (parse-integer (string ch)
283                                                      :radix 36 
284                                                      :junk-allowed nil)))
285                         finally (return n)) 97))
286           account))
287
288
289 (defmethod set-iban ((self iban) (iban string) &key (with-key nil))
290   "
291 DO:     Change the IBAN. If WITH-KEY is true then the IBAN key is checked
292         and an error raised if it is not valid, else the IBAN key is
293         computed and substituted.
294 RETURN: SELF
295 RAISE:  An IBAN-ERROR when with-key and the key in the IBAN is incorrect.
296 "
297   (setf iban (get-and-check-alphanum 
298               self (remove-if (complement (function alphanumericp)) iban)))
299   (setf (slot-value self 'basic-form) 
300         (if with-key
301             (if (check-iban-key iban)
302                 iban
303                 (error 'iban-error
304                        :format-control "For IBAN ~S~%    Invalid key, given=~S, computed=~S."
305                        :format-arguments (list iban
306                                                (subseq iban 2 4)
307                                                (subseq (compute-iban-key (subseq iban 0 2)
308                                                                          (subseq iban 4)) 2 4))))
309             (compute-iban-key (subseq iban 0 2) (subseq iban 4))))
310   (check-country self)
311   self)
312
313 ;;;; THE END ;;;;