source: project/release/4/isbn/trunk/isbn.scm @ 22215

Last change on this file since 22215 was 22215, checked in by Christian Kellermann, 10 years ago

isbn: refactor isbn10->isbn13 thanks to alaric

File size: 2.9 KB
Line 
1(module isbn
2   (normalize-isbn
3    valid-isbn?
4    isbn10->isbn13
5    isbn13->isbn10
6    isbn-type)
7
8   (import chicken scheme)
9   (use srfi-1)
10
11   (define (recalculate-isbn10-checkdigit isbn)
12     (append (drop-right isbn 1)
13             (list (- 11 (modulo (fold (lambda (x y seed)
14                                         (+ seed (* x y)))
15                                       0
16                                       (iota 10 10 -1)
17                                       (take isbn 9))
18                                 11)))))
19
20   (define (isbn13->isbn10 isbn-string)
21     (let ((isbn (string->isbn isbn-string)))
22       (when (not (equal? '(9 7 8) (take isbn 3)))
23             (error "Unable to convert this isbn since it is not unambigous with any other prefix than 978"))
24
25       (isbn->string
26        (recalculate-isbn10-checkdigit (take (drop isbn 3) 10)))))
27
28   (define (valid-isbn10-checksum? isbn)
29     (= 0 (modulo (fold (lambda (x y seed)
30                          (+ seed (* x y)))
31                        0
32                        (iota 10 10 -1)
33                        isbn)
34                  11)))
35
36   (define (valid-isbn10? isbn)
37     (and (= (length isbn) 10)
38          (valid-isbn10-checksum? isbn)))
39
40   (define (isbn13-checkdigit isbn)
41     (- 10
42        (modulo (fold
43                 (lambda (y x s) (+ s (* x y)))
44                 0
45                 (take (circular-list 1 3) 12)
46                 (take isbn 12))
47                10)))
48
49   (define (valid-isbn13-checksum? isbn)
50     (= (last isbn) (isbn13-checkdigit isbn)))
51
52   (define (valid-isbn13? isbn)
53     (and (= (length isbn) 13)
54          (valid-isbn13-checksum? isbn)))
55
56   (define (isbn-type isbn-string)
57     (let ((isbn (string->isbn isbn-string)))
58       (cond
59        ((valid-isbn10? isbn) 10)
60        ((valid-isbn13? isbn) 13)
61        (else #f))))
62
63   (define (valid-isbn? isbn-string) (not (not (isbn-type isbn-string))))
64
65   (define (string->isbn isbn-str)
66     (let ((isbn (fold (lambda (x s)
67                         (if x (cons x s) s))
68                       '()
69                       (map
70                        (lambda (s)
71                          (if (or (equal? s "x") ; XXX this is ugly
72                                  (equal? s "X"))
73                              10
74                              (string->number s)))
75                        (map
76                         string
77                         (string->list isbn-str))))))
78       (if (and (= (length isbn) 13)
79                (= (car isbn) 0))
80           (set-car! isbn 10))
81       (reverse isbn)))
82
83   (define (isbn->string isbn)
84     (let* ((isbn-orig (reverse isbn))
85            (isbn
86             (cond ((and (= (length isbn-orig) 13)
87                         (= (car isbn-orig) 10))
88                    (cons 0 (cdr isbn-orig)))
89                   ((and (= (length isbn-orig) 10)
90                         (= (car isbn-orig) 10))
91                    (cons "X" (cdr isbn-orig)))
92                   (else isbn-orig))))
93       (fold string-append ""
94             (map (lambda (x)
95                    (if (equal? "X" x) x (number->string x)))
96                  isbn))))
97   
98   (define (isbn10->isbn13 isbn10-string)
99     (and-let* ((isbn10 (string->isbn isbn10-string))
100                ((valid-isbn10? isbn10))
101                (isbn10-sans-checkdigit (take isbn10 9))
102                (isbn13-sans-checkdigit
103                 (append '(9 7 8) isbn10-sans-checkdigit))
104                (isbn13
105                 (append isbn13-sans-checkdigit
106                         (list (isbn13-checkdigit isbn13-sans-checkdigit)))))
107               (isbn->string isbn13)))
108
109
110   (define (normalize-isbn isbn-string)
111     (when (not (valid-isbn? isbn-string))
112           (error "invalid ISBN" isbn-string))
113     (isbn->string (string->isbn isbn-string))))
Note: See TracBrowser for help on using the repository browser.