; isbn validation
(define (drop n xs)
(let loop ((n n) (xs xs))
(if (or (zero? n) (null? xs)) xs
(loop (- n 1) (cdr xs)))))
(define (read-line . port)
(define (eat p c)
(if (and (not (eof-object? (peek-char p)))
(char=? (peek-char p) c))
(read-char p)))
(let ((p (if (null? port) (current-input-port) (car port))))
(let loop ((c (read-char p)) (line '()))
(cond ((eof-object? c) (if (null? line) c (list->string (reverse line))))
((char=? #\newline c) (eat p #\return) (list->string (reverse line)))
((char=? #\return c) (eat p #\newline) (list->string (reverse line)))
(else (loop (read-char p) (cons c line)))))))
(define (clean isbn? str)
(let loop ((cs (string->list str)) (out '()))
(cond ((null? cs) (reverse out))
((and isbn? (null? (cdr cs)) (char-ci=? (car cs) #\X))
(reverse (cons (car cs) out)))
((char-numeric? (car cs))
(loop (cdr cs) (cons (car cs) out)))
(else (loop (cdr cs) out)))))
(define (isbn? str)
(let loop ((cs (clean #t str)) (mul 10) (sum 0))
(if (null? cs) (zero? (modulo sum 11))
(loop (cdr cs) (- mul 1) (+ sum (* mul
(if (char-ci=? (car cs) #\X) 10
(- (char->integer (car cs)) 48))))))))
(define (ean? str)
(let loop ((cs (clean #f str)) (mul 1) (sum 0))
(if (null? cs) (zero? (modulo sum 10))
(loop (cdr cs) (- 4 mul) (+ sum (* mul
(- (char->integer (car cs)) 48))))))))
(define (isbn->ean str)
(if (not (isbn? str)) (error 'isbn->ean "invalid isbn")
(let loop ((cs (clean #t str)) (ean '(#\8 #\7 #\9))
(mul 3) (sum 38))
(if (null? (cdr cs))
(list->string (reverse (cons (integer->char (+
(modulo (- 10 (modulo sum 10)) 10) 48)) ean)))
(loop (cdr cs) (cons (car cs) ean) (- 4 mul)
(+ sum (* mul (- (char->integer (car cs)) 48))))))))
(define (ean->isbn str)
(if (not (ean? str)) (error 'ean->isbn "invalid ean")
(let loop ((cs (drop 3 (clean #f str))) (isbn '())
(mul 10) (sum 0))
(if (null? (cdr cs))
(list->string (reverse
(cons (let ((d (modulo sum 11)))
(cond ((= d 0) #\0) ((= d 1) #\X)
(else (integer->char (- 59 d)))))
isbn)))
(loop (cdr cs) (cons (car cs) isbn) (- mul 1)
(+ sum (* mul (- (char->integer (car cs)) 48))))))))
;(define wget "c:\\cygwin\\bin\\wget -qO") ; windows/cygwin
;(define wget "/usr/local/bin/wget -qO") ; unix/hp
(define wget "/usr/bin/wget -q0") ; linux/ubuntu
(define (tempname)
(let loop ((i 0))
(let ((f (string-append "temp" (number->string i))))
(if (file-exists? f) (loop (+ i 1)) f))))
(define (with-input-from-url url thunk)
(let ((f (tempname)))
(if (zero? (system (string-append wget " " f " \"" url "\"")))
(begin (with-input-from-file f thunk) (delete-file f #t))
(error 'with-input-from-url "system error in wget"))))
(define access-key "12345678") ; not a valid key
(define (display-isbndb.com isbn)
(with-input-from-url
(string-append "http://isbndb.com/api/books.xml?access_key="
access-key "&index1=isbn&value1="
(list->string (clean #t isbn)))
(lambda ()
(do ((c (read-char) (read-char))) ((eof-object? c))
(display c)))))
(define (lookup-isbn isbn)
(with-input-from-url
(string-append "http://isbndb.com/api/books.xml?access_key="
access-key "&index1=isbn&value1="
(list->string (clean #t isbn)))
(lambda ()
(do ((str (read-line) (read-line))) ((eof-object? str))
(when (and (< 7 (string-length str))
(string=? (substring str 0 7) "<Title>"))
(display "Title: ")
(display (substring str 7 (- (string-length str) 8)))
(newline))
(when (and (< 13 (string-length str))
(string=? (substring str 0 13) "<AuthorsText>"))
(display "Authors: ")
(display (substring str 13 (- (string-length str) 14)))
(newline))))))
(lookup-isbn "0070004846")