File: isbn.tcl

package info (click to toggle)
tcllib 2.0%2Bdfsg-5
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 83,560 kB
  • sloc: tcl: 306,798; ansic: 14,272; sh: 3,035; xml: 1,766; yacc: 1,157; pascal: 881; makefile: 124; perl: 84; f90: 84; python: 33; ruby: 13; php: 11
file content (176 lines) | stat: -rw-r--r-- 4,699 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
# # ## ### ##### ######## ############# ######################
## Validation of ISBN numbers.
#
## ISBN-10 and -13 numbers are handled. The later are issued since
## Jan 1, 2007. ISBN-10 numbers indicate books issued before that date.
## I.e. Books after the date do not have ISBN-10 numbers any longer.
## Books with an ISBN-10 have a canconical ISBN-13 equivalent
## number. See method '13of'.

## Note that ISBN-13 numbers are essentially EAN-13 numbers with
## country codes 'Bookland' and 'Musicland', i.e. 978 and 979.
#
# References
#	http://www.augustana.ab.ca/~mohrj/algorithms/checkdigit.html
#	http://en.wikipedia.org/wiki/International_Standard_Book_Number

# # ## ### ##### ######## ############# ######################

# The code below implements the interface of a snit validation type,
# making it directly usable with snit's -type option in option
# specifications.

# The result of the validation is always a proper isbn13 code, even if
# the input was isbn10. In this manner inputs are normalized to the
# canonical format.

# # ## ### ##### ######## ############# ######################
## Requisites

package require Tcl 8.5 9
package require snit
package require valtype::common

# # ## ### ##### ######## ############# ######################
## Implementation

namespace eval ::valtype::isbn {
    namespace import ::valtype::common::*
}

snit::type ::valtype::isbn {
    #-------------------------------------------------------------------
    # Type Methods

    typemethod validate {value} {
	if {![regexp {^[0-9]+[Xx]?$} $value]} {
	    badchar ISBN "ISBN number, expected only digits, and possibly 'X' or 'x' as checkdigit"
	}

	switch -exact -- [string length $value] {
	    10 {
		set sum 0
		foreach \
		    d [string map {x 10 X 10} [lreverse [split $value {}]]] \
		    w {1 2 3 4 5 6 7 8 9 10} {
			incr sum [expr {$d * $w}]
		    }
		if {($sum % 11) != 0} {
		    badcheck ISBN "ISBN number"
		}

		# Normalize isbn10 to its isbn13 equivalent.

		set n 978[string range $value 0 end-1]
		return $n[$type checkdigit $n]
	    }
	    13 {
		if {![string match 978* $value] &&
		    ![string match 979* $value]} {
		    badprefix ISBN {978 979} "ISBN number"
		}

		set sum [Sum $value]
		if {($sum % 10) != 0} {
		    badcheck ISBN "ISBN number"
		}
	    }
	    default {
		badlength ISBN {10 13} "ISBN number"
	    }
	}

	return $value
    }

    typemethod checkdigit {value} {
	if {![regexp {^[0-9]+[Xx]?$} $value]} {
	    badchar ISBN "ISBN number (without checkdigit), expected only digits"
	}

	switch -exact -- [string length $value] {
	    9 {
		set sum 0
		foreach \
		    d [lreverse [split $value {}]] \
		    w {2 3 4 5 6 7 8 9 10} {
			incr sum [expr {$d * $w}]
		    }

		set c [expr {11 - ($sum % 11)}]
		if {$c == 11} { set c 0 }
		if {$c == 10} { set c X }
	    }
	    12 {
		if {![string match 978* $value] &&
		    ![string match 979* $value]} {
		    badprefix ISBN {978 979} "ISBN number (without checkdigit)"
		}

		set c [expr {10 - ([Sum $value] % 10)}]
		if {$c == 10} { set c 0 }
	    }
	    default {
		badlength ISBN {9 12} "ISBN number (without checkdigit)"
	    }
	}

	return $c
    }

    # Convert isbn10 to isbn13.

    # Note that isbn13 numbers are valid ean13 codes with 'country
    # code' 978, aka 'bookland'. As space has run out the country code
    # 979 'Musicland' (see ISMN) is repurposed and phased in. This
    # however does not affect the conversion of isbn10 numbers, their
    # equivalents are all in the 978 region.

    typemethod 13of {value} {
	if {![regexp {^[0-9]+[Xx]?$} $value]} {
	    badchar ISBN "ISBN-10 number, expected only digits, and possibly 'X' or 'x' as checkdigit"
	} elseif {[string length $value] != 10} {
	    badlength ISBN 10 "ISBN-10 number"
	}

	# Strip the -10 check digit, prefix the remainder with the
	# bookland country code and recalculate the check digit, via
	# -13.

	set n 978[string range $value 0 end-1]
	return $n[$type checkdigit $n]
    }

    # NOTE: Same as EAN13
    proc Sum {value} {
	#  i| 0 1 2 3  4  5  6  7  8  9
	# *3| 0 3 6 9 12 15 18 21 24 27

	set sum 0
	set flip 1
	foreach d [string map {x 10 X 10} [split $value {}]] {
	    incr sum [lindex {
		{0 1 2 3 4 5 6 7 8 9 10}
		{0 3 6 9 12 15 18 21 24 27 30}
	    } [expr {[incr flip] & 1}] $d]
	}
	return $sum
    }

    #-------------------------------------------------------------------
    # Constructor

    # None needed; no options

    #-------------------------------------------------------------------
    # Public Methods

    method validate {value} {
        $type validate $value
    }
}

# # ## ### ##### ######## ############# ######################
## Ready

package provide valtype::isbn 1.1