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

Last change on this file since 22174 was 22174, checked in by Christian Kellermann, 9 years ago

isbn: isbn13->isbn10 added

File size: 3.5 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 (isbn13->string isbn)
99     (string-append
100      (number->string (list-ref isbn 0))
101      (number->string (list-ref isbn 1))
102      (number->string (list-ref isbn 2))
103      "-"
104      (number->string (list-ref isbn 3))
105      "-"
106      (number->string (list-ref isbn 4))
107      (number->string (list-ref isbn 5))
108      (number->string (list-ref isbn 6))
109      (number->string (list-ref isbn 7))
110      (number->string (list-ref isbn 8))
111      "-"
112      (number->string (list-ref isbn 9))
113      (number->string (list-ref isbn 10))
114      (number->string (list-ref isbn 11))
115      "-"
116      (number->string
117       (if (= (list-ref isbn 12) 10) 0
118           (list-ref isbn 12)))))
119
120   (define (isbn10->isbn13 isbn10-string)
121     (and-let* ((isbn10 (string->isbn isbn10-string))
122                ((valid-isbn10? isbn10))
123                (isbn10-sans-checkdigit (take isbn10 9))
124                (isbn13-sans-checkdigit
125                 (append '(9 7 8) isbn10-sans-checkdigit))
126                (isbn13
127                 (append isbn13-sans-checkdigit
128                         (list (isbn13-checkdigit isbn13-sans-checkdigit)))))
129               (isbn13->string isbn13)))
130
131
132   (define (normalize-isbn isbn-string)
133     (when (not (valid-isbn? isbn-string))
134           (error "invalid ISBN" isbn-string))
135     (isbn->string (string->isbn isbn-string))))
Note: See TracBrowser for help on using the repository browser.