The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Business::RU::BankAccount;

use strict;
use warnings;

use Moose::Role;
requires 'current_account',
         'correspondent_account',
         'bic';

sub validate_current_account {
    my $self = shift;

    return $self -> _validate_account(
        sprintf "%s%s", substr( $self -> bic(), 6, 3 ), $self -> current_account()
    );
}

sub validate_correspondent_account {
    my $self = shift;    

    return $self -> _validate_account(
        sprintf "0%s%s", substr( $self -> bic(), 4, 2), $self -> correspondent_account()
    );
}

sub _validate_account {
    my ($self, $account) = @_;

    my @weights = qw(7 1 3 7 1 3 7 1 3 7 1 3 7 1 3 7 1 3 7 1 3 7 1);
    my $result = 0;
    for ( my $i = 0; $i < 23; $i++ ) {
        $result += substr( $account, $i, 1 ) * $weights[$i];
    }

    return $result % 10 == 0;
}

sub validate_bic {
    my $self = shift;

    return 
        length( $self -> bic()) == 9  &&  
        $self -> bic() =~ /^04/ &&
        $self -> bic() !~ /00[3-9]$|0[1-4]\d$/;
}

1;

__END__

=pod

=head1 NAME

Business::RU::BankAccount

=head1 VERSION

version 0.1

=head1 SYNOPSIS

    package myDecorator;
    use Moose;
    has 'current_account' => ( is => 'ro', isa => 'Int' );
    has 'correspondent_account' => ( is => 'ro', isa => 'Int' );
    has 'bic' => ( is => 'ro', isa => 'Int' );
    with 'Business::RU::BankAccount';

    ...

    my $decorator = myDecorator  ->  new( 
        current_account => $current_account,
        correspondents_account => $correspondent_account,
        bic => $bic,    
    );
    if( $decorator -> validate_bic() &&
        $decorator -> validate_current_account() &&
        $decorator -> validate_correspondent_account() ) {
        ... success ...
    } else {
        ... process error ...
    }

=head1 DESCRIPTION

Validate bank account details - BIC, current and correspondent accounts.
B<NOTE:> This role expects that it's consuming class will have a C<bic>, 
C<current_account> and C<correspondent_account> methods.

=head1 METHODS

=head2 validate_current_account()

=head2 validate_correspondent_account()

=head2 validate_bic()

=head2 _validate_account()

Calculate bank accont check sum.
Internal method.

=head1 SEE ALSO

L<http://ru.wikipedia.org/wiki/%D0%91%D0%B0%D0%BD%D0%BA%D0%BE%D0%B2%D1%81%D0%BA%D0%B8%D0%B9_%D1%81%D1%87%D0%B5%D1%82>

=head1 BUGS

Please report any bugs through the web interface at L<http://rt.cpan.org> 
or L<https://github.com/GermanS/Business-RU>

=head1 AUTHOR

German Semenkov
german.semenkov@gmail.com

=head1 COPYRIGHT AND LICENSE

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut