File Coverage

blib/lib/Business/AU/ABN.pm

Criterion	Covered	Total	%
statement	61	61	100.0
branch	23	26	88.4
condition	5	9	55.5
subroutine	16	16	100.0
pod	4	4	100.0
total	109	116	93.9

package Business::AU::ABN;

# Implements algorithm for validating ABNs, detailed by the ATO at
# http://www.ato.gov.au/content/downloads/nat2956.pdf

# See POD at the end of the file

use 5.005;
use strict;
use Exporter          ();
use List::Util   1.11 ();
use Params::Util 0.25 ();
use overload '""'   => 'to_string',
             'bool' => sub () { 1 };

# The set of digit weightings, taken from the documentation.
use constant WEIGHT => qw{10 1 3 5 7 9 11 13 15 17 19};

use vars qw{$VERSION @ISA @EXPORT_OK $errstr};
BEGIN {
	$VERSION   = '1.09';
	@ISA       = 'Exporter';
	@EXPORT_OK = 'validate_abn';
	$errstr    = '';
}





#####################################################################
# Constructor

sub new {
	my $class = ref $_[0] || $_[0];

	# Validate the string to create the object for
	my $validated = $class->_validate_abn($_[1]) or return '';

	bless( \$validated, $class );
}

# The validate_abn method acts as a wrapper for the various call
# forms around the true method _validate_abn.
sub validate_abn {
	# Object method
	if ( Params::Util::_INSTANCE( $_[0], 'Business::AU::ABN' ) ) {
		return $_[0]->to_string;
	}

	# Class method
	if ( Params::Util::_CLASSISA($_[0], 'Business::AU::ABN') ) {
		return $_[0]->_validate_abn($_[1]);
	}

	# Function call
	__PACKAGE__->_validate_abn($_[0]);
}

# Do the ACTUAL check, called in class method context only.
# I've tried to keep the code here very very simple, which takes a
# little more memory, but is much more obvious in function.
# Returns true if correct, false if not, or undef on error.
sub _validate_abn {
	my $class = shift;
	$errstr = '';

	# Make sure we at least have a string to check
	my $abn = $class->_string($_[0]) ? shift
		: return $class->_error( 'No value provided to check' );

	# Check we have only whitespace ( which we remove ) and digits
	$abn =~ s/\s+//gs;
	return $class->_error( 'ABN contains invalid characters' ) if $abn =~ /\D/;

	# Initial validation is based on the number of digits.
	# An ABN with a "group number" attached is 14 digits.
	my $group = '';
	if ( length $abn == 14 ) {
		($abn, $group) = $abn =~ /^(\d{11})(\d{3})$/ or die 'Regex unexpectedly failed';

		# Group numbers are allocated sequentially, starting at 001.
		# This means that 000 is not a legal group identifier.
		if ( $group eq '000' ) {
			return $class->_error( 'Cannot have the group identifier 000' );
		}

	} elsif ( length $abn != 11 ) {
		return $class->_error( 'ABNs are 11 digits, not ' . length $abn );
	}

	# Split the 11 digit ABN into an 11 element array
	my @digits = $abn =~ /\d/g;

	# Quotes are directly from the algorithm documentation
	# "Step 1. Subtract 1 from the first ( left ) digit to give a new 11 digit number"
	$digits[0] -= 1;

	# "Step 2. Multiply each of the digits in this new number by its weighting factor"
	@digits = map { $digits[$_] * (WEIGHT)[$_] } (0 .. 10);

	# "Step 3. Sum the resulting 11 products"
	# "Step 4. Divide the total by 89, noting the remainder"
	# "Step 5. If the remainder is zero the number is valid"
	if ( List::Util::sum(@digits) % 89 ) {
		return $class->_error( 'ABN looks correct, but fails checksum' );
	}

	# Format and return
	$abn =~ s/^(\d{2})(\d{3})(\d{3})(\d{3})$/$1 $2 $3 $4/ or die "panic!";
	length($group) ? "$abn $group" : $abn;
}

# Get the ABN as a string
sub to_string { ${$_[0]} }

# Get the error message when validation returns false.
sub errstr { $errstr }





#####################################################################
# Utility Methods

# Is a value a non-null non-whitespace string
sub _string {
	!! (defined $_[1] and ! ref $_[1] and length $_[1] and $_[1] =~ /\S/);
}

sub _error {
	$errstr = (defined $_[1] and $_[1]) ? "$_[1]" : 'Unknown error while validating ABN';
	''; # False
}

1;

__END__