Changeset 22174 in project for release/4/isbn/trunk/isbn.scm

Timestamp:

01/02/11 23:49:25 (10 years ago)

Author:

Christian Kellermann

Message:

isbn: isbn13->isbn10 added

File:

• release/4/isbn/trunk/isbn.scm (modified) (3 diffs)

release/4/isbn/trunk/isbn.scm

@@ -3 +3 @@
     valid-isbn?
     isbn10->isbn13
+    isbn13->isbn10
     isbn-type)
 
    (import chicken scheme)
    (use srfi-1)
+
+   (define (recalculate-isbn10-checkdigit isbn)
+     (append (drop-right isbn 1)
+             (list (- 11 (modulo (fold (lambda (x y seed)
+                                         (+ seed (* x y)))
+                                       0
+                                       (iota 10 10 -1)
+                                       (take isbn 9))
+                                 11)))))
+
+   (define (isbn13->isbn10 isbn-string)
+     (let ((isbn (string->isbn isbn-string)))
+       (when (not (equal? '(9 7 8) (take isbn 3)))
+             (error "Unable to convert this isbn since it is not unambigous with any other prefix than 978"))
+
+       (isbn->string
+        (recalculate-isbn10-checkdigit (take (drop isbn 3) 10)))))
 
    (define (valid-isbn10-checksum? isbn)
@@ -63 +81 @@
        (reverse isbn)))
 
+   (define (isbn->string isbn)
+     (let* ((isbn-orig (reverse isbn))
+            (isbn
+             (cond ((and (= (length isbn-orig) 13)
+                         (= (car isbn-orig) 10))
+                    (cons 0 (cdr isbn-orig)))
+                   ((and (= (length isbn-orig) 10)
+                         (= (car isbn-orig) 10))
+                    (cons "X" (cdr isbn-orig)))
+                   (else isbn-orig))))
+       (fold string-append ""
+             (map (lambda (x)
+                    (if (equal? "X" x) x (number->string x)))
+                  isbn))))
+   
    (define (isbn13->string isbn)
      (string-append
@@ -96 +129 @@
                (isbn13->string isbn13)))
 
-   (define (normalize-isbn isbn)
-     (let* ((isbn-orig (reverse (string->isbn isbn)))
-            (isbn
-             (cond ((and (= (length isbn-orig) 13)
-                         (= (car isbn-orig) 10))
-                    (cons 0 (cdr isbn-orig)))
-                   ((and (= (length isbn-orig) 10)
-                         (= (car isbn-orig) 10))
-                    (cons "X" (cdr isbn-orig)))
-                   (else (error "Not a valid length for an isbn" isbn)))))
-       (fold string-append ""
-             (map (lambda (x)
-                    (if (equal? "X" x) x (number->string x)))
-                  isbn)))))
+
+   (define (normalize-isbn isbn-string)
+     (when (not (valid-isbn? isbn-string))
+           (error "invalid ISBN" isbn-string))
+     (isbn->string (string->isbn isbn-string))))