#!/usr/local/bin/perl -w
# Sample code for processing ISAN and V-ISAN identifiers

# File at: http://www.finseth.com/isan.pl

# Written October 2000 by Craig A. Finseth, craig@firwood.net
# Revised March 2001 by Craig A. Finseth to remove variable allocations.
# Revised August 2001 by Craig A. Finseth to use lid: and V-ISAN
# Revised June 2004 by Craig A. Finseth to include XML
# Revised 5 January 2006 by Craig A. Finseth to adjust V-ISAN label and correct
#	check digit calculations.

# This code is NOT copyright.

# The purpose of this entire file is to encourage the complete and
# correct implementation of ISAN or V-ISAN handling code by providing
# a working example.

# The program as a whole is not intended to be used as is.  Rather, it
# exists as a framework for exercising the individual modules.  Each
# module can be used as is, with the exception that all other modules
# assume that ISAN_Normalize has been called on the input data.

# Note that these modules are written for clarity, not efficiency.

# For reference, here is the digit allocation table.
#
# digits of root				12
# digits of episode				4
# digits of minor version(in V-ISAN portion)	8

@TESTDATA = (
	"b159-d8fa-0124-0000-k",
	"1881-66c7-3420-0000-3",
	"1881-66c7-3420-0000-3-9f3a-0245-q",
	"1234567890abcdef",
	"1234567890abcdefj",
	"0123456789abcdef01234567",
	"0123456789abcdef5012345679",
	"0 1  23 4,./<>?56!@#^&*()_-+=|\\7890AbCdEc[]{}",
	);

$ISAN_PRINT_PREFIX = "isan: ";
$VISAN_PRINT_PREFIX = "isan: ";

# ------------------------------------------------------------

if ($#ARGV < -1) {
USAGE:
	print "usage: isan [options] <identifier(s)>
displays test data if no identifiers are supplied
options:
	-h|human	human input; check digit required
	-v|verbose	be verbose in output\n";
	exit 1;
	}

$opt_h = 0;
$opt_v = 0;

@ids = ();

while ($#ARGV >= 0) {
	$x = shift(@ARGV);
	$arg = $x;
	$arg =~ tr/A-Z/a-z/;
	if ($arg eq "-h" || $arg eq "-human") {
		$opt_h = 1;
		}
	elsif ($arg eq "-v" || $arg eq "-verbose") {
		$opt_v = 1;
		}
	elsif ($arg =~ /^\-/) {
		goto USAGE;
		}
	else	{
		push(@ids, $x);
		}
	}

$| = 1 if ($opt_v);

# --------------------

# do each supplied value

if ($#ids < 0) {
	foreach $t (@TESTDATA) {
		&Do($t, 0);
		}
	}
else	{
	foreach $i (@ids) {
		&Do($i, $opt_h);
		}
	}

exit 0;

# ------------------------------------------------------------
# Do one value

sub Do ($$) {
	my ($x, $is_human) = @_;
	my ($status) = undef;

	print "\n----------------------------------------\n";

	print "Supplied ID:\t\t'$x'\n";
	if (($status = &ISAN_Normalize($x, $is_human)) ne "") {
		print "$status\n\n";
		return;
		}
	$x = $result;

	print "Normalized value:\t'$x'\n";

	$savex = $x;
	$x = &ISAN_AddCheckDigits($x),

	print "Printed:\n";
	print "\tISAN:\t\t", &ISAN_ToPrinted(&ISAN_ExtractISANCheck($x)), "\n";
	print "\tV-ISAN:\t\t", &ISAN_ToPrinted($x), "\n";

	print "XML:\n";
	print "\tISAN:\t\t", &ISAN_ToXML(&ISAN_ExtractISANCheck($x)), "'\n";
	print "\tV-ISAN:\t\t", &ISAN_ToXML($x), "'\n";

	print "Basic:\n";
	print "\troot:\t\t", &ISAN_ExtractRoot($x), "\n";
	print "\tepisode/part:\t", &ISAN_ExtractEpisode($x), "\n";
	print "\tversion:\t", &ISAN_ExtractVersion($x), "\n";

	print "Identifiers w/o check character:\n";
	print "\tISAN:\t\t", &ISAN_ExtractISANNoCheck($x), "\n";
	print "\tV-ISAN:\t\t", &ISAN_ExtractVISANNoCheck($x), "\n";

	print "Check characters:\n";
	print "\tISAN portion:\t\t", &ISAN_ComputeISANCheckDigit($x), "\n";
	print "\tV-ISAN portion:\t\t", &ISAN_ComputeVISANCheckDigit($x), "\n";

	print "Verify:\n";
	print "\tISAN check digit:\t", &ISAN_VerifyISANCheckDigit($savex), "\n";
	print "\tV-ISAN check digit:\t", &ISAN_VerifyVISANCheckDigit($savex), "\n";
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and computes and
# adds the check digit(s).  If the check digit(s) are already
# present, it returns the supplied identifier.  It returns the
# empty string if the argument is not an ISAN or V-ISAN.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_AddCheckDigits ($) {
	my ($x) = @_;
	my ($len) = length($x);

	if ($len == 16) {
		return $x . &ISAN_ComputeISANCheckDigit($x);
		}
	elsif ($len == 17) {
		return $x;
		}
	elsif ($len == 24) {
		return substr($x, 0, 16) . &ISAN_ComputeISANCheckDigit($x) .
			substr($x, 16, 8) . &ISAN_ComputeVISANCheckDigit($x);
		}
	elsif ($len == 26) {
		return $x;
		}
	else	{
		return "";
		}
	}


# ------------------------------------------------------------
# This module accepts a string of hexadecimal digits and computes
# and returns the check digit.  It assumes the string has been
# normalized and performs no error checking.

# The algorithm is from ISO 7064.  The name is MOD 37,36.

sub ISAN_ComputeCheckDigit ($) {
	my ($x) = @_;
	my ($len1) = length($x) - 1;
	my ($chars) = "0123456789abcdefghijklmnopqrstuvwxyz";

	my ($S, $AS, $P, $AP) = undef;
	my ($MOD1) = 37;
	my ($MOD2) = 36;

	print "Checksum, string '$x':\nindex	char	S/adjS	P/adjP\n"
		if ($opt_v);

	for $i (0..$len1) {
		if ($i == 0) {
# ISAN Handbook says to add $MOD2 as in the first step and the ISO
# standard says to start at 0.  Since we will be doing a mod 36 later,
# it doesn't matter which we do.
#			$S = index($chars, substr($x, $i, 1)) + $MOD2;
			$S = index($chars, substr($x, $i, 1));
			}
		else	{
			$S = index($chars, substr($x, $i, 1)) + $AP;
			}

		if ($S > $MOD2) {
			$AS = $S - $MOD2;
			}
		else	{
			$AS = $S;
			}
		if ($AS == 0) { $AS = $MOD2; }

		$P = $AS * 2;

		if ($P >= $MOD1) {
			$AP = $P - $MOD1;
			}
		else	{
			$AP = $P;
			}

		print "$i	", substr($x, $i, 1), "	$S/$AS	$P/$AP\n"
			if ($opt_v);
		}

	if ($AP == 1) {
		print "returning '", substr($chars, 0, 1), "'\n"
			if ($opt_v);
		return substr($chars, 0, 1);
		}
	else	{
		print "returning '", substr($chars, $MOD1 - $AP, 1), "'\n"
			if ($opt_v);
		return substr($chars, $MOD1 - $AP, 1);
		}
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and computes the
# first (ISAN) check digit.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_ComputeISANCheckDigit ($) {
	my ($x) = @_;
	&ISAN_ComputeCheckDigit(substr($x, 0, 16));
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and computes the
# second (V-ISAN) check digit.  The empty string is returned if
# there is no V-ISAN portion.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_ComputeVISANCheckDigit ($) {
	my ($x) = @_;
	my ($len) = length($x);

	if ($len == 16) {
		return "";
		}
	elsif ($len == 17) {
		return "";
		}
	elsif ($len == 24) {
		return &ISAN_ComputeCheckDigit($x);
		}
	elsif ($len == 26) {	# do not include the ISAN check digit
		return &ISAN_ComputeCheckDigit(
			substr($x, 0, 16) . substr($x, 17, 8));
		}
	else	{
		return "";
		}
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and extracts
# and returns the episode identifier portion.  The empty string
# is returned if there is no episode portion.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_ExtractEpisode ($) {
	my ($x) = @_;
	substr($x, 12, 4);
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and extracts
# and returns the ISAN portion.  If check digits are present,
# they are retained.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_ExtractISANCheck ($) {
	my ($x) = @_;
	my ($len) = length($x);

	if ($len == 16) {
		return $x;
		}
	elsif ($len == 17) {
		return $x
		}
	elsif ($len == 24) {
		return substr($x, 0, 16);
		}
	elsif ($len == 26) {
		return substr($x, 0, 17);
		}
	else	{
		return "";
		}
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and extracts
# and returns the ISAN without check digits.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_ExtractISANNoCheck ($) {
	my ($x) = @_;
	my ($len) = length($x);

	if ($len == 16) {
		return $x;
		}
	elsif ($len == 17) {
		return substr($x, 0, 16);
		}
	elsif ($len == 24) {
		return substr($x, 0, 16);
		}
	elsif ($len == 26) {
		return substr($x, 0, 16);
		}
	else	{
		return "";
		}
	}


# ------------------------------------------------------------
# This module accepts an ISAN V-ISAN identifier and extracts
# and returns the root identifier portion.  The empty string
# is returned if there is no root identifier portion.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_ExtractRoot ($) {
	my ($x) = @_;

	substr($x, 0, 12);
	}


# ------------------------------------------------------------
# This module accepts an ISAN V-ISAN identifier and extracts
# and returns the root identifier portion with dashes.  The empty
# string is returned if there is no root identifier portion.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_ExtractRootDash ($) {
	my ($x) = @_;
	my ($r) = &ISAN_ExtractRoot($x);
	substr($r, 0, 4) . "-" . substr($r, 4, 4) . "-" . substr($r, 8, 4);
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and extracts
# and returns the version portion.  The empty string is returned
# if there is no major version portion.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_ExtractVersion ($) {
	my ($x) = @_;
	my ($len) = length($x);

	if ($len == 16) {
		return "";
		}
	elsif ($len == 17) {
		return "";
		}
	elsif ($len == 24) {
		return substr($x, 16, 8);
		}
	elsif ($len == 26) {
		return substr($x, 17, 8);
		}
	else	{
		return "";
		}
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and extracts
# and returns the version portion with a dash.  The empty string
# is returned if there is no major version portion.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_ExtractVersionDash ($) {
	my ($x) = @_;
	my ($v) = &ISAN_ExtractVersion($x);
	substr($v, 0, 4) . "-" . substr($v, 4, 4);
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and extracts
# and returns the V-ISAN portion without check digits.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_ExtractVISANNoCheck ($) {
	my ($x) = @_;
	my ($len) = length($x);

	if ($len == 16) {
		return $x;
		}
	elsif ($len == 17) {
		return substr($x, 0, 16);
		}
	elsif ($len == 24) {
		return $x;
		}
	elsif ($len == 26) {
		return substr($x, 0, 16) . substr($x, 17, 8);
		}
	else	{
		return "";
		}
	}


# ------------------------------------------------------------
# This module accepts a string and prepares it for use by the
# other modules.   It performs these operations:
#
# 1) Remove all characters that are not the letters A-Z or the digits 0-9.
# 2) Convert all letters to lower case.
# 3) Verify that the string is exactly 16, 17, 24, or 26 characters long.
# 4) Verify that all characters other than the check digit(s) are
#    hexadecimal values (i.e., not the letters G-Z).
# 5) If the string is 17 or 26 characters long, verify the check digit(s).
# 6) Verify that the first character is in the range 0 to 9.
#
# If the normalized string is a valid ISAN or V-ISAN, this module returns
# the null string ("") and sets the global variable $result to the
# normalized string.
#
# Otherwise, the module returns a string describing the problem and
# does not alter the value of the $result variable.
#
# If $is_human is true, the module assumes that input is from a human
# and requires the check digit.

sub ISAN_Normalize ($$) {
	my ($x, $is_human) = @_;

	print "Normalize, starting '$x'\n" if ($opt_v);

	# remove all non-letters and digits
	$x =~ tr/A-Za-z0-9//cd;
	print "Normalize, bad chars gone '$x'\n" if ($opt_v);

	# convert to lower case
	$x =~ tr/A-Z/a-z/;
	print "Normalize, lower case '$x'\n" if ($opt_v);

	# verify length, digits, and checksum
	my ($len) = length($x);
	if ($len == 16) {
		return "digit characters must be 0-9,a-f" if ($x =~ /g-z/);
		return "check digit required" if ($is_human);
		}
	elsif ($len == 17) {
		return "digit characters must be 0-9,a-f"
			if (substr($x, 0, 16) =~ /g-z/);
		return "bad checksum"
			if (&ISAN_VerifyISANCheckDigit($x) ne "true");
		}
	elsif ($len == 24) {
		return "digit characters must be 0-9,a-f"
			if (substr($x, 0, 16) =~ /g-z/);
		return "digit characters must be 0-9,a-f"
			if (substr($x, 16, 8) =~ /g-z/);
		return "check digits required" if ($is_human);
		}
	elsif ($len == 26) {
		return "digit characters must be 0-9,a-f"
			if (substr($x, 0, 16) =~ /g-z/);
		return "digit characters must be 0-9,a-f"
			if (substr($x, 17, 8) =~ /g-z/);
		return "bad checksum"
			if (&ISAN_VerifyISANCheckDigit($x) ne "true");
		return "bad checksum"
			if (&ISAN_VerifyVISANCheckDigit($x) ne "true");
		}
	else	{
		return "invalid length";
		}

	$result = $x;
	"";
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and returns identifier
# formatted for printing.
#
# The empty string is returned if there is no identifier
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_ToString ($) {
	my ($x) = @_;
	my ($len) = length($x);

	if ($len == 16) {
		return substr($x, 0, 4) . "-" .
			substr($x, 4, 4) . "-" .
			substr($x, 8, 4) . "-" .
			substr($x, 12, 4);
		}
	elsif ($len == 17) {
		return substr($x, 0, 4) . "-" .
			substr($x, 4, 4) . "-" .
			substr($x, 8, 4) . "-" .
			substr($x, 12, 4) . "-" .
			substr($x, 16, 1);
		}
	elsif ($len == 24) {
		return substr($x, 0, 4) . "-" .
			substr($x, 4, 4) . "-" .
			substr($x, 8, 4) . "-" .
			substr($x, 12, 4) . "-" .
			substr($x, 16, 4) . "-" .
			substr($x, 20, 4);
		}
	elsif ($len == 26) {
		return substr($x, 0, 4) . "-" .
			substr($x, 4, 4) . "-" .
			substr($x, 8, 4) . "-" .
			substr($x, 12, 4) . "-" .
			substr($x, 16, 1) . "-" .
			substr($x, 17, 4) . "-" .
			substr($x, 21, 4) . "-" .
			substr($x, 25, 1);
		}
	else	{
		return "";
		}
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and returns the
# identifier formatted for printing and always with a check digit.
#
# The empty string is returned if there is no identifier
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_ToStringCheck ($) {
	my ($x) = @_;
	my ($len) = length($x);

	if ($len == 16) {
		return substr($x, 0, 4) . "-" .
			substr($x, 4, 4) . "-" .
			substr($x, 8, 4) . "-" .
			substr($x, 12, 4) . "-" .
			&ISAN_ComputeISANCheckDigit($x);
		}
	elsif ($len == 17) {
		return substr($x, 0, 4) . "-" .
			substr($x, 4, 4) . "-" .
			substr($x, 8, 4) . "-" .
			substr($x, 12, 4) . "-" .
			substr($x, 16, 1);
		}
	elsif ($len == 24) {
		return substr($x, 0, 4) . "-" .
			substr($x, 4, 4) . "-" .
			substr($x, 8, 4) . "-" .
			substr($x, 12, 4) . "-" .
			&ISAN_ComputeISANCheckDigit($x) . "-" .
			substr($x, 16, 4) . "-" .
			substr($x, 20, 4) . "-" .
			&ISAN_ComputeVISANCheckDigit($x);
		}
	elsif ($len == 26) {
		return substr($x, 0, 4) . "-" .
			substr($x, 4, 4) . "-" .
			substr($x, 8, 4) . "-" .
			substr($x, 12, 4) . "-" .
			substr($x, 16, 1) . "-" .
			substr($x, 17, 4) . "-" .
			substr($x, 21, 4) . "-" .
			substr($x, 25, 1);
		}
	else	{
		return "";
		}
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and returns the
# equivalent printed form.
#
# The empty string is returned if there is no root or episode portion.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_ToPrinted ($) {
	my ($x) = @_;
	my ($len) = length($x);

	if ($len == 16) {
		return $ISAN_PRINT_PREFIX . &ISAN_ToString($x);
		}
	elsif ($len == 17) {
		return $ISAN_PRINT_PREFIX . &ISAN_ToString($x);
		}
	elsif ($len == 24) {
		return $VISAN_PRINT_PREFIX . &ISAN_ToString($x);
		}
	elsif ($len == 26) {
		return $VISAN_PRINT_PREFIX . &ISAN_ToString($x);
		}
	else	{
		return "";
		}
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and returns the
# equivalent XML form.
#
# The empty string is returned if there is no root or episode portion.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_ToXML ($) {
	my ($x) = @_;
	my ($len) = length($x);

	if ($len == 16) {
		return "<isan root=\"" .
			&ISAN_ExtractRootDash($x) .
			"\" episodeOrPart=\"" .
			&ISAN_ExtractEpisode($x) .
			"\"/>";
		}
	elsif ($len == 17) {
		return "<isan root=\"" .
			&ISAN_ExtractRootDash($x) .
			"\" episodeOrPart=\"" .
			&ISAN_ExtractEpisode($x) .
			"\" check1=\"" .
			substr($x, 16, 1) .
			"\"/>";
		}
	elsif ($len == 24) {
		return "<isan root=\"" .
			&ISAN_ExtractRootDash($x) .
			"\" episodeOrPart=\"" .
			&ISAN_ExtractEpisode($x) .
			"\" check1=\"" .
			substr($x, 16, 1) .
			"\" version=\"" .
			&ISAN_ExtractVersionDash($x) .
			"\"/>";
		}
	elsif ($len == 26) {
		return "<isan root=\"" .
			&ISAN_ExtractRootDash($x) .
			"\" episodeOrPart=\"" .
			&ISAN_ExtractEpisode($x) .
			"\" check1=\"" .
			substr($x, 16, 1) .
			"\" version=\"" .
			&ISAN_ExtractVersionDash($x) .
			"\" check2=\"" .
			substr($x, 25, 1) .
			"\"/>";
		}
	else	{
		return "";
		}
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and verifies the
# first (ISAN) check digit.  It returns the string "true" if the
# check digit matches, "false" if not, or some other string if
# the verification was unable to take place.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_VerifyISANCheckDigit ($) {
	my ($x) = @_;
	my ($len) = length($x);

	if ($len == 16) {
		return "no check digit"
		}
	elsif ($len == 17) {
		my ($ci) = &ISAN_ComputeISANCheckDigit($x);
		return ($ci eq substr($x, 16, 1)) ? "true" : "false";
		}
	elsif ($len == 24) {
		return "no check digit";
		}
	elsif ($len == 26) {
		my ($ci) = &ISAN_ComputeISANCheckDigit($x);
		return ($ci eq substr($x, 16, 1)) ? "true" : "false";
		}
	else	{
		return "no check digit";
		}
	}


# ------------------------------------------------------------
# This module accepts an ISAN or V-ISAN identifier and verifies the
# second (V-ISAN) check digit.  It returns the string "true" if the
# check digit matches, "false" if not, or some other string if
# the verification was unable to take place.
#
# This module assumes that its argument is the $result string
# from an ISAN_Normalize call that returned the empty string.

sub ISAN_VerifyVISANCheckDigit ($) {
	my ($x) = @_;
	my ($len) = length($x);

	if ($len == 16) {
		return "no check digit"
		}
	elsif ($len == 17) {
		return "no check digit"
		}
	elsif ($len == 24) {
		return "no check digit";
		}
	elsif ($len == 26) {
		my ($cu) = &ISAN_ComputeVISANCheckDigit($x);
		return ($cu eq substr($x, 25, 1)) ? "true" : "false";
		}
	else	{
		return "no check digit";
		}
	}