REBOL [
	name: 'CAS-RN
	title: "CAS Registry Number"
	file: %cas-rn.r
	home: none
	date: 2005-10-25
	version: 1.0.1
	home: none
	author: "Daniel Rybowski"
	email: HJWRKOJWLMJJ@spammotel.com ; Yes, this is a real email address!
	purpose: {The CAS Registry (http://www.cas.org/EO/regsys.html) is a widely
		used database of chemical substances. The CAS Registry Numbers are a "de
		facto" standard for the identification of chemical substances.

		This module contains helper functions to handle CAS Registry Numbers.}
	history: [
		"Daniel Rybowski" 1.0.1 2005-10-25 "Parse in func split uses a charset."
		"Daniel Rybowski" 1.0.0 2005-10-22 "Initial release."
	]
	library: [
		level: 'intermediate
		platform: 'all
		type: [module function tool]
		domain: 'scientific
        tested-under: "View 1.3.1.3.1 on Windows XP"
        support: none
        license: 'cc-by-sa
        see-also: none
	]
]
cas-rn: context [
	exists?: func [
		{Returns TRUE if a CAS Registry Number is valid and has been allocated
		by the CAS.}
		cas-rn [issue!] "The CAS RN to verify."
		/local last-cas-rn cas-rn-1 last-cas-rn-1
	][
		found? all [
			valid? cas-rn
			parse read http://www.cas.org/cgi-bin/regreport.pl [
				thru "CAS RN"
				thru 
				copy last-cas-rn to 
				to end
			]
			cas-rn: split cas-rn
			last-cas-rn: split last-cas-rn
			cas-rn-1: to-integer first cas-rn
			last-cas-rn-1: to-integer first last-cas-rn
			any [
				cas-rn-1 < last-cas-rn-1
				all [
					cas-rn-1 = last-cas-rn-1
					lesser-or-equal?
						to-integer second cas-rn
						to-integer second last-cas-rn
				]
			]
		]
	]
	valid?: func [
		{Returns TRUE if a CAS Registry Number is valid. This does not
		necessarily mean that this Registry Number has been allocated by the
		CAS.}
		cas-rn [issue!] "The CAS RN to validate."
	][
		found? all [
			cas-rn: split cas-rn
			; For my purpose, leading zeroes must be disallowed in a CAS RN.
			; Comment out the following line to allow them.
			#"0" <> first first cas-rn
			; The first allocated CAS RN is #50-00-0.
			50 <= to-integer first cas-rn
			equal?
				compute-check-digit first cas-rn second cas-rn
				to-integer third cas-rn
		]
	]
	compute-check-digit: func [
		{Returns the check digit corresponding to a CAS Registry Number. Applies
		the algorithm specified at http://www.cas.org/EO/checkdig.html.}
		rn-1 [string!] "The first group of 2 to 6 digits of a CAS RN."
		rn-2 [string!] "The second group of 2 digits of a CAS RN."
		/local total
	][
		total: local: 0
		foreach digit reverse join rn-1 rn-2 [
			local: local + 1
			total: total + multiply local to-integer to-string digit
		]
		total // 10
	]
	split: func [
		{Splits a CAS Registry Number into its 3 groups of digits. Returns a
		block of 3 strings, or NONE if the CAS RN is malformed.}
		cas-rn [issue! string!] "The CAS RN to split."
		/local digits part-1 part-2 part-3
	][
		digits: charset "0123456789"
		if parse cas-rn [
			copy part-1 2 6 digits
			"-"
			copy part-2 2 digits
			"-"
			copy part-3 digits
			end
		][
			reduce [part-1 part-2 part-3]
		]
	]
]
comment [
    ; Usage examples
    cas-rn/exists? #107-07-3 ; == true

    cas-rn/valid? #0107-07-3 ; == false

    cas-rn/compute-check-digit "999999" "99" ; == 4
    cas-rn/valid? #999999-99-4 ; == true
    cas-rn/exists? #999999-99-4 ; == false

    cas-rn/split #123-45-6 ; == ["123" "45" "6"]
    cas-rn/split "123-45-6" ; == ["123" "45" "6"]
]