(in-package #:isbn)

(defmethod isbn-prefix ((isbn isbn-13))
  (subseq (isbn-digits isbn) 0 3))

(defun search-ranges (ranges digits &key (start 0))
  (let ((length nil))
    (loop
     for (beginning a-length) in ranges
     while (string<= beginning digits :start2 start
		     :end2 (+ start (length beginning)))
     do (setf length a-length))
    length))

(defun parse-group (digits &key (start 0) (prefix "978"))
  (let ((ranges (gethash prefix *isbn-group-ranges*)))
    (unless ranges
      (error "Group ranges not known for prefix ~A." prefix))
    (subseq digits start
	    (+ start (search-ranges ranges digits :start start)))))

(defmethod isbn-group ((isbn isbn-10))
  (parse-group (isbn-digits isbn) :start 0))

(defmethod isbn-group ((isbn isbn-13))
  (parse-group (isbn-digits isbn) :start 3 :prefix (isbn-prefix isbn)))

(defun registrant-1 (digits group prefix-length)
  (let ((ranges (gethash group *isbn-registrant-ranges*)))
    (unless ranges
      (error "Registrant ranges not known for group ~A." group))
    (subseq digits (+ prefix-length (length group))
	    (+ prefix-length (length group) 
	       (search-ranges ranges digits
			      :start (+ prefix-length (length group)))))))

(defmethod isbn-registrant ((isbn isbn-10))
  (registrant-1 (isbn-digits isbn) (isbn-group isbn) 0))

(defmethod isbn-registrant ((isbn isbn-13))
  (registrant-1 (isbn-digits isbn) (isbn-group isbn) 3))

(defmethod isbn-publication ((isbn isbn-10))
  (let ((group (isbn-group isbn))
	(registrant (isbn-registrant isbn)))
    (subseq (isbn-digits isbn) (+ (length group) (length registrant)) 9)))

(defmethod isbn-publication ((isbn isbn-13))
  (let ((group (isbn-group isbn))
	(registrant (isbn-registrant isbn)))
    (subseq (isbn-digits isbn) (+ 3 (length group) (length registrant)) 12)))

(defmethod isbn-check-digit ((isbn isbn))
  (let ((digits (isbn-digits isbn)))
    (subseq digits (1- (length digits)))))

(defgeneric format-isbn (isbn)
  (:documentation 
   "Returns a string containing the correctly hyphenated external
representation of ISBN.  May fail if information necessary to
hyphenate ISBN is missing from the internal tables.  This may happen
when the international ISBN agency adds new prefixes and 
groups (countries) or the national ISBN bureaus add new ranges of 
registrants (publishers)."))

(defmethod format-isbn ((isbn isbn-10))
  (concatenate 'string (isbn-group isbn) "-" (isbn-registrant isbn) "-"
	       (isbn-publication isbn) "-" (isbn-check-digit isbn)))

(defmethod format-isbn ((isbn isbn-13))
  (concatenate 'string (isbn-prefix isbn) "-" (isbn-group isbn) "-" 
	       (isbn-registrant isbn) "-" (isbn-publication isbn) "-"
	       (isbn-check-digit isbn)))

(defclass format-isbn-test-case (test-case)
  ((formatted-isbns :accessor formatted-isbns)
   (invalid-isbns :accessor invalid-isbns)))

(defmethod set-up ((test format-isbn-test-case))
  (setf (formatted-isbns test) '("0-00-000000-0" "0-19-999999-0"
				 "0-200-00000-0" "0-699-99999-0"
				 "0-7000-0000-0" "0-8499-9999-0"
				 "0-85000-000-0" "0-89999-999-0"
				 "0-900000-00-0" "0-949999-99-0"
				 "0-9500000-0-0" "0-9999999-9-0"
				 "1-00-000000-0" "1-09-999999-0"
				 "1-100-00000-0" "1-399-99999-0"
				 "1-4000-0000-0" "1-5499-9999-0"
				 "1-55000-000-0" "1-86979-999-0"
				 "1-869800-00-0" "1-998999-99-0"
				 "1-9990000-0-0" "1-9999999-9-0"
				 "82-00-00000-0" "82-19-00000-0"
				 "82-200-0000-0" "82-599-9999-9"
				 "82-7000-000-0" "82-8999-999-9"
				 "82-90000-00-0" "82-98999-99-9"
				 "82-990000-0-0" "82-999999-9-9"
				 "0-201-89683-4"
				 )
	(invalid-isbns test) '("82-600-0000-0" "82-699-9999-9"
			       "0-201-89683-4")))

(def-test-method test-format-isbn ((test format-isbn-test-case))
  (dolist (correct (formatted-isbns test))
    (let ((input (remove #\- correct)))
      (let ((output (format-isbn (parse-isbn input 
					     :invalid-check-digit :correct))))
	(setf (char output (1- (length output))) 
	      (char correct (1- (length correct))))
	(assert-equal output correct output)))))

(def-test-method test-format-isbn-invalid ((test format-isbn-test-case) 
					   :run nil)
  (dolist (invalid (invalid-isbns test))
    (assert-condition 'error (format-isbn (remove #\- invalid)))))

(def-test-method test-format-isbn-10 ((test isbn-test-case))
  (dolist (string (correct-formats-10 test))
    (assert-equal string (format-isbn (parse-isbn string)))))

(def-test-method test-format-isbn-13 ((test isbn-test-case))
  (dolist (string (correct-formats-13 test))
    (assert-equal string (format-isbn (parse-isbn string)))))