File Coverage

lib/Finance/MICR/LineParser.pm

Criterion	Covered	Total	%
statement	217	247	87.8
branch	97	130	74.6
condition	30	34	88.2
subroutine	32	34	94.1
pod	22	24	91.6
total	398	469	84.8

package Finance::MICR::LineParser;
use strict;
use Carp;
use warnings;
our $VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)/g;

sub new {
	my ($class,$self) = (shift,shift);
	$self ||= {};
	$self->{string} or croak('missing string argument to constructor');

	$self->{transit_symbol}		||='T';
	$self->{on_us_symbol}		||='U';
	$self->{ammount_symbol}		||='X';
	$self->{dash_symbol}			||='D';

	$self->{max_clean_runs} ||= 6;

	bless $self, $class;

	$self->{original_string} = $self->{string};

	until( $self->_match or $self->giveup) {
		$self->_clean_string; # returns 0 if it should not clean anymore
	}

	# $self->{return_my_symbols} ||=0; # later

	return $self;
}

sub tolerant {
	my $self = shift;
	(defined $self->{tolerant}) or ($self->{tolerant} = 1);	# could be 0
	return $self->{tolerant};
}


sub _match {
	my $self = shift;
	if ($self->_business_check_match){ return 1;} # will not run if max_clean_runs HAS been reached
	if ($self->_personal_check_match){ return 1;} # will not run if max_clean_runs HAS been reached
	if ($self->_unknown_check_match ){ return 1;} # will not run if max_clean_runs has NOT been reached & tolerant is true
	return 0;
}


sub clean_runs {
	my $self = shift;
	$self->{_clean_runs} ||= 0;
	return $self->{_clean_runs};
}

sub max_clean_runs {
	my $self = shift;
	return $self->{max_clean_runs};
}


sub _clean_string {
	my $self = shift;

	if( $self->clean_runs > $self->max_clean_runs ){
		return 0;
	}

	if ($self->clean_runs == 0){
		my ($u,$t,$a,$d) = ($self->{on_us_symbol}, $self->{transit_symbol}, $self->{ammount_symbol}, $self->{dash_symbol});
		if ($t ne 'T'){
				$self->{string}=~s/$t/T/g;
		}
		if ($u ne 'U'){
				$self->{string}=~s/$u/U/g;
		}
		if ($a ne 'X'){
				$self->{string}=~s/$a/X/g;
		}
		if ($d ne 'D'){
				$self->{string}=~s/$d/D/g;
		}
	}

	elsif ($self->clean_runs == 1){
		$self->{string} =~s/\s+//g;
	}

	elsif ($self->clean_runs == 2){
		$self->{string} =~s/_|\-//g;
	}

	elsif ($self->clean_runs == 3){
		$self->{string} =~s/[^0123456789TUXD]//g;
	}

	elsif ($self->clean_runs == 4){
		if( $self->{string}=~m/(T[0123456789TUXD]+U)/ ){ # business check # realize if there's a trailing X (ammount) this will fail
			$self->{string} = $1;
		}
		elsif ( $self->{string}=~m/(U[0123456789TUXD]+U[0123456789TUXD]*)/){
			$self->{string} = $1;
		}
	}

	$self->{_clean_runs}++;
	return 1;
}


sub giveup {
	my $self = shift;
	$self->{_giveup} ||=0;
	return $self->{_giveup};
}





# -------------------------------------------
# BEGIN MAIN MATCHERS
# ALL MAIN MATCHING IS DONE IN THESE TWO SUBS
# if they both fail continuosly, then we dont assume to
# succeed

sub _business_check_match {
	my $self= shift;
	my $string = $self->{string};

	if($string =~/(U[\dD]+U)[\-_\s]*(T\d{9}T)[\-_\s]*([\dD ]+U[\-_\s]*[\dD ]*)/){
		$self->_set_check_type('business');
		$self->{auxiliary_on_us} = $1; $self->{auxiliary_on_us}=~s/\s{2,}/ /g;
		$self->{transit} = $2; $self->{transit}=~s/\s{2,}/ /g;
		$self->{on_us} = $3; $self->{on_us}=~s/\s{2,}/ /g;
		return 1;
	}
	return 0;
}

sub _personal_check_match {
	my $self= shift;
	my $string = $self->{string};

	#insist that a valid personal check have trailing digits after the U
	if ($string =~/(T\d{9}T)[\-_\s]*([\dD ]+U\s*[\dD ]+)/){
		$self->_set_check_type('personal');
		$self->{transit} = $1; $self->{transit}=~s/\s{2,}/ /g;
		$self->{on_us} = $2; $self->{on_us}=~s/\s{2,}/ /g;
		return 1;
	}
	return 0;
}

# aka hacky match
sub _unknown_check_match {
	my $self = shift;

	# what conditions does this run on
	# first off, there can not be a match type already
	if($self->get_check_type) { return; }

	# second, we must have already exhausted the clean runs we can make
	# otherwise , it will attempt to match an unclean string before
	# the other match methods get a chance to succeed.
	# clean_runs can be less then max_clean_runs, but only if a check type
	# match was already established, thus, we would not get here at all
	($self->clean_runs > $self->max_clean_runs) or return;

	# third, tolerant flag must be set to true
	# also, _unknown_check_match() is a last resource, so set giveup flag if not tolerant.
	unless ($self->tolerant){ $self->{_giveup} = 1; return; }



	# reset the string
	$self->{string} = $self->{original_string};



		my ($u,$t,$a,$d) = ($self->{on_us_symbol}, $self->{transit_symbol}, $self->{ammount_symbol}, $self->{dash_symbol});
		if ($t ne 'T'){
				$self->{string}=~s/$t/T/g;
		}
		if ($u ne 'U'){
				$self->{string}=~s/$u/U/g;
		}
		if ($a ne 'X'){
				$self->{string}=~s/$a/X/g;
		}
		if ($d ne 'D'){
				$self->{string}=~s/$d/D/g;
		}



	my $match=0;
	my $string = $self->{string}; # TODO: MAKE SURE - is this *really* a copy of what is in self??????
	# because we are hacking away at it here..

	if ($string=~s/(U[\dD]+U)//) { #aux on us
		$self->{auxiliary_on_us} = $1;
		$match++;
	}

	if ($string=~s/(T\d{9}T)//){
		$self->{transit}= $1;
		$match++;
	}

	if ($string=~/[^U](\d{5,18}U[\dD]*)/ ) { # how many digits can this be? can the account number have dashes?
		$self->{on_us} = $1;
		$match++;
	}


	# we want to assert that if we resorted to *this* method of matching fields, this is was a crappy string
	# to begin with.

	if( $match ){
		$self->_set_check_type('unknown');
		return 1; # return $match;
	}

	# _unknown_check_match() is a last resource, so set giveup flag since there was
	# no match by this point
	$self->{_giveup} = 1;
	return 0;
}







# END MAIN MATCHERS
# -------------------------------------------







# summary MICR string info

sub micr {
	my $self = shift;
	#$self->valid or return;

#	my $micr = $self->{string};

#	$micr=~s/\s|\-|_//g;
	my $micr;

	if ($self->is_business_check){
		$micr .= $self->auxiliary_on_us . $self->transit . $self->on_us;
	}

	elsif ($self->is_personal_check){
		$micr .= $self->transit . $self->on_us;
	}

	elsif ($self->is_unknown_check){ # assume / guess that it's a business check
		$micr .= $self->auxiliary_on_us ? $self->auxiliary_on_us : 'UxxxxxxU';
		$micr .= $self->transit ? $self->transit : 'TxxxxxxT';
		$micr .= $self->on_us ? $self->on_us :  'xxxxxxU';
	}
	else {
		return;
	}

	return $micr;
}

sub micr_pretty {
	my $self = shift;
	my $micr = $self->micr or return;
	$micr=~s/ /_/g;
	for( $micr ) {
    s/([^[:^alpha:]xuUD])([\dxuDU]+\1)/_$1$2_/g;
    s/(?<=([^\dxuUD_]))?([\dxuDU]+)([^\dxuDU_])/
        $2 . $3 . ( $1 eq $3 ? '' : '_' )
    /ge;
    s/_(_|$)/$1/g;
	}

	$micr=~s/^_+|_{2,}|_+$//g;
	return $micr;
}


sub original_string {
	my $self-> shift;
	return $self->{orginal_string};
}

sub is_business_check {
	my $self = shift;
	$self->{is_business_check} ||=0;
	return $self->{is_business_check};
}
sub is_personal_check{
	my $self = shift;
	$self->{is_personal_check} ||=0;
	return $self->{is_personal_check};
}

sub is_unknown_check {
	my $self = shift;
	$self->{is_unknown_check} ||=0;
	return $self->{is_unknown_check};
}

sub get_check_type {
	my $self = shift;
	!$self->is_business_check or return 'b';
	!$self->is_personal_check or return 'p';
	!$self->is_unknown_check or return 'u';
	return;
}

sub _set_check_type {
	my $self = shift;
	my $type = shift; $type or croak('missing arg to _set_check_type()');
	$type=~/^b|^p|^u/i or croak("type:[$type] unrecognized type, use (u)nknown, (b)usiness, or (p)ersonal");

	$self->{is_business_check} = ($type=~/^b/i or 0);
	$self->{is_personal_check} = ($type=~/^p/i or 0);
	$self->{is_unknown_check} = ($type=~/^u/i or 0);
	return 1;
}




# main MICR METHODS
# the five major fields

sub auxiliary_on_us {
	my $self = shift;
	defined $self->{auxiliary_on_us} or return;
	return $self->{auxiliary_on_us};
}

sub on_us {
	my $self = shift;
	defined $self->{on_us} or return;
	return $self->{on_us};
}




# ----------------------------------
# transit and subfields

sub transit {
	my $self = shift;
	defined $self->{transit} or return;
	if (defined $self->{check_digit}){ return $self->{transit}; }

	my $transit = $self->{transit};
	#$transit=~s/T//g;
	$transit=~/T(\d{1})(\d{4})(\d{4})T$/ or die("transit() returns messed up:[$transit], should begin with the transit symbol, have 9 digits, and end in the transit symbol.");

	$self->{check_digit} = $1;
	$self->{bank_number} = $2;
	$self->{routing_number} = $3;

	return $self->{transit};
}

sub check_digit {
	my $self = shift;
	$self->transit or return;
	return $self->{check_digit};
}


sub bank_number {
	my $self = shift;
	$self->transit or return;
	return $self->{bank_number};
}

sub routing_number {
	my $self = shift;
	$self->transit or return;
	return $self->{routing_number};
}


# end transit and subfields



# TODO: this is not fully functional
sub epc {
	my $self = shift;
	defined $self->{epc} or return;
	return $self->{epc};
}

# TODO: this is not fully functional
sub ammount {
	my $self = shift;
	defined $self->{ammount} or return;
	return $self->{ammount};
}






sub account_number {
	my $self = shift;
	if (defined $self->{account_number}){ return $self->{account_number}; }

	$self->on_us or return; # if not defined, we cant extract bank number

	if ( $self->on_us=~/([\dD ]{5,19})U/ ){
		$self->{account_number} = $1;
		return $self->{account_number};
	}
	return;
}



sub check_number {
	my $self = shift;
	if( defined $self->{check_number}){ return $self->{check_number}; }
	# a lot of this is sort of redundant, but i put it here for reasoning for a viewer

	# check number may be on the on us or in the aux on us

	if ($self->is_business_check){
			$self->{check_number} = $self->auxiliary_on_us;
			$self->{check_number}=~s/U//g;
			#$self->{check_number}=~s/^0+//;
			return $self->{check_number};
	}
	elsif ($self->is_personal_check){
			if ($self->on_us=~/U\s*(\d+)/ ){
				$self->{check_number} = $1;
				#$self->{check_number}=~s/^0+//;
				return $self->{check_number};
			}
			else {
				return; # personal check with no check number
			}
	}


	if ($self->is_unknown_check){

		# at this point the string is not a valid() MICR check string .. the
		# procedures are sameish.. but we made sure type is unknown
		if ($self->auxiliary_on_us){
				$self->{check_number} = $self->auxiliary_on_us;
				$self->{check_number}=~s/U//g;
				#$self->{check_number}=~s/^0+//;
				return $self->{check_number};
		}

		elsif ($self->on_us){
			if ($self->on_us=~/U([\d]+)/ ){
				$self->{check_number} = $1;
				#$self->{check_number}=~s/^0+//;
				return $self->{check_number};
			}
		}
	}

	return;
}





sub valid {
	my $self = shift;
	if ($self->is_personal_check or $self->is_business_check){
		return 1;
	}
	return 0;
}


sub status {
	my $self = shift;
	no warnings;


	my $out = sprintf "original string [%s]\n",$self->{original_string};
	$out.= sprintf "runs: [%s]\n",			$self->clean_runs;
	$out.= sprintf "string: [%s]\n",			$self->{string};
	$out.= sprintf"giveup: [%s]\n",			$self->giveup;
	$out.= sprintf"transit: [%s]\n",		$self->transit;
	$out.= sprintf"on_us: [%s]\n",			$self->on_us;
	$out.= sprintf"account #: [%s]\n",		$self->account_number ;
	$out.= sprintf"check #: [%s]\n",		$self->check_number;
	$out.= sprintf"is personal: [%s]\n",	$self->is_personal_check;
	$out.= sprintf"is business: [%s]\n",	$self->is_business_check;
	$out.= sprintf"bank_number: [%s]\n",	$self->bank_number;
	$out.= sprintf"routing number: [%s]\n",	$self->routing_number;
	$out.= sprintf"epc: [%s]\n",	$self->epc;
	$out.= sprintf"check_digit: [%s]\n",	$self->check_digit;
	$out.= sprintf"is valid: [%s]\n",	$self->valid;
	$out.= sprintf"check type: [%s]\n",	$self->get_check_type;
	$out.= sprintf"micr: [%s]\n",	$self->micr;
	$out.= sprintf"micr_pretty: [%s]\n",	$self->micr_pretty;


	return $out;
}




1;
__END__