package Algorithm::NIN;

use strict; use warnings;

=head1 NAME

Algorithm::NIN - Interface to UK's National Insurance Number.

=head1 VERSION

Version 1.04

=cut

our $VERSION = '1.04';
our $DEBUG   = 0;

use Carp;
use Readonly;
use Data::Dumper;

Readonly my $TOO_SHORT                 => "NI number can't be shorter than 8 characters";
Readonly my $TOO_LONG                  => "NI number can't be longer than 9 characters";
Readonly my $INVALID_FIRST_LETTER      => "First letter of NI number can't be D,F,I,Q,U or V";
Readonly my $INVALID_SECOND_LETTER     => "Second letter of NI number can't be D,F,I,O,Q,U or V";
Readonly my $FIRST_TWO_LETTERS_INVALID => "First two lettes of NI number can't be BG,GB,NK,KN,NT or ZZ";
Readonly my $LAST_LETTER_INVALID       => "Last letter of NI number can only be A,B,C,D or a number";
Readonly my $MISSING_NUMBERS           => "NI number should have 6 numbers after the first two alphabets";
Readonly my $INVALID_TEMP_NUMBER       => "Temporary NI number should always start with TN and ends with either M or F";
Readonly my $INVALID_DOB               => "Temporary NI number contains invalid date of birth";

Readonly my @VALID_PARAM => qw 
[
    fiscal_year   gross_per_week annual_profit
    self_employed married        sex
    class
];

# Class 1   - Employed.
# Class 2/4 - Self-employed.
# Class 3   - Voluntary contributions.
# Rate A    - Applied to any earnings between PRIMARY THRESHOLD and UPPER EARNINGS LIMIT.
# Rate B    - Anything above UPPER EARNINGS LIMIT plus Rate A.

# According to official website [ http://www.hmrc.gov.uk/rates/nic.htm ].
Readonly my $TABLE =>
{
    '2009-10' => 
    {
        'UPPER_EARNINGS_LIMIT_PW'       => 844,
        'PRIMARY_THRESHOLD_PW'          => 110,
        'CLASS_1_RATE_A'                => .11,
        'CLASS_1_RATE_B'                => .01,
        'CLASS_2_FLAT_PW'               => 2.4,
        'CLASS_3_FLAT_PW'               => 12.05,
        'CLASS_4_LOWER_PROFIT_LIMIT_PA' => 5715,
        'CLASS_4_UPPER_PROFIT_LIMIT_PA' => 43875,
        'CLASS_4_RATE_A'                => .08,
        'CLASS_4_RATE_B'                => .01,
        'MARRIED_WOMEN_RATE_A'          => .0485,
        'MARRIED_WOMEN_RATE_B'          => .01,
    },
    '2010-11' => 
    {
        'UPPER_EARNINGS_LIMIT_PW'       => 844,
        'PRIMARY_THRESHOLD_PW'          => 110,
        'CLASS_1_RATE_A'                => .11,
        'CLASS_1_RATE_B'                => .01,
        'CLASS_2_FLAT_PW'               => 2.4,
        'CLASS_3_FLAT_PW'               => 12.05,
        'CLASS_4_LOWER_PROFIT_LIMIT_PA' => 5715,
        'CLASS_4_UPPER_PROFIT_LIMIT_PA' => 43875,
        'CLASS_4_RATE_A'                => .08,
        'CLASS_4_RATE_B'                => .01,
        'MARRIED_WOMEN_RATE_A'          => .0485,
        'MARRIED_WOMEN_RATE_B'          => .01,
    },
    '2011-12' => 
    {
        'UPPER_EARNINGS_LIMIT_PW'       => 817,
        'PRIMARY_THRESHOLD_PW'          => 139,
        'CLASS_1_RATE_A'                => .12,
        'CLASS_1_RATE_B'                => .02,
        'CLASS_2_FLAT_PW'               => 2.5,
        'CLASS_3_FLAT_PW'               => 12.60,
        'CLASS_4_LOWER_PROFIT_LIMIT_PA' => 7225,
        'CLASS_4_UPPER_PROFIT_LIMIT_PA' => 42475,
        'CLASS_4_RATE_A'                => .09,
        'CLASS_4_RATE_B'                => .02,
        'MARRIED_WOMEN_RATE_A'          => .0585,
        'MARRIED_WOMEN_RATE_B'          => .02,
    },
};

=head1 DESCRIPTION

This modules lets you validate UK National Insurance Number.  This also has functionalities to
format and calculate the NI.

=head1 METHODS

=head2 validate()

This  method accepts National Insurance number and validate it against the UK format. For more
information please visit http://en.wikipedia.org/wiki/National_Insurance_UK

    use strict; use warnings;
    use Algorithm::NIN;

    my ($ni, $status);
    $ni     = 'AA123456C';
    $status = Algorithm::NIN::validate($ni);

    # or
    
    $ni     = 'AA 12 34 56 C';
    $status = Algorithm::NIN::validate($ni);

=cut

sub validate
{
    my $ni = shift;
    return 0 unless defined $ni;
    
    chomp($ni);
    $ni =~ s/\s+//g;
    
    croak(_error($TOO_SHORT))                 if (length($ni) < 8);
    croak(_error($TOO_LONG))                  if (length($ni) > 9);
    croak(_error($INVALID_FIRST_LETTER))      if ($ni =~ m/^(D|F|I|Q|U|V)/i);
    croak(_error($INVALID_SECOND_LETTER))     if ($ni =~ m/^[A-Z](D|F|I|O|Q|U|V)/i);
    croak(_error($FIRST_TWO_LETTERS_INVALID)) if ($ni =~ m/^(BG|GB|NK|KN|NT|ZZ)/i);
    croak(_error($LAST_LETTER_INVALID))       if ($ni =~ m/(E|G-L|N-Z)$/i);
    croak(_error($MISSING_NUMBERS))           if ($ni !~ m/[A-Z][A-Z]\d\d\d\d\d\d/i);
    croak(_error($INVALID_TEMP_NUMBER))       if (($ni =~ m/^TN/i) && ($ni !~ m/[M|F]$/i));

    if (($ni =~ m/^TN/i) && ($ni =~ m/[M|F]$/i))
    {
        $ni =~ /^TN(\d\d)(\d\d)(\d\d)/;
        croak(_error($INVALID_DOB)) if (($1 > 31) || ($2 > 12) || ($3 == 0));
    }
    return 1;
}

=head2 format()

This method accepts National Insurance number and returns back in the pair format. For example
'AA1234546C' would become 'AA 12 34 56 C' as it appears on NI card.

    use strict; use warnings;
    use Algorithm::NIN;

    my ($ni);
    $ni = 'AA123456C';
    $ni = Algorithm::NIN::format($ni);

=cut

sub format 
{
    my $ni = shift;
    if (validate($ni))
    {
        my @ni = split(//,$ni);
        (scalar(@ni) == 9)
        ?
        return sprintf("%s%s %d%d %d%d %d%d %s", 
            $ni[0],$ni[1],  $ni[2],$ni[3], $ni[4],$ni[5], $ni[6],$ni[7], $ni[8])
        :
        return sprintf("%s%s %d%d %d%d %d%d", 
            $ni[0],$ni[1],  $ni[2],$ni[3], $ni[4],$ni[5], $ni[6],$ni[7]);
    }
    return;
}

=head2 calculateNI()

Returns NI contributions (approx) according to HMRC website http://www.hmrc.gov.uk/rates/nic.htm
It only covers fiscal year 2009-10, 2010-11 & 2011-12.I don't claim the number you get back is
exactly what you see in your pay slip. This is simply my attempt to understand the internal of
mathematics  behind  the NI  contributions. Suggestion to improve the functionality  is highly 
appreciated. This method accepts the following parameter as hashref.

    +----------------+-------------------------------------+
    | Key            | Values                              |      
    +----------------+-------------------------------------+
    | fiscal_year    | '2009-10' or '2010-11' or '2011-12' |
    | gross_per_week | 60000, when no class is provided    |  
    | annual_profit  | 5000, only when class is 4          |
    | self_employed  | 1 or 0                              |
    | married        | 1 or 0                              |
    | sex            | 'm' or 'f'                          |
    | class          | 1 - for employed                    | 
    |                | 2 - for self employed               | 
    |                | 3 - for voluntary contributions     |    
    |                | 4 - for self employed               |
    +----------------+-------------------------------------+

    use strict; use warnings;
    use Algorithm::NIN;

    my ($ni);
    $ni = Algorithm::NIN::calculateNI({ 
          fiscal_year    => '2010-11', 
          gross_per_week => 65000, 
          self_employed  => 1, 
          class          => 2 });

    # or
    
    $ni = Algorithm::NIN::calculateNI({ 
          fiscal_year => '2010-11', 
          class       => 3 });
          
    # or
    
    $ni = Algorithm::NIN::calculateNI({ 
          fiscal_year   => '2010-11', 
          annual_profit => 10000, 
          self_employed => 1, 
          class         => 4 });

    # or
    
    $ni = Algorithm::NIN::calculateNI({ 
          fiscal_year    => '2010-11', 
          gross_per_week => 450, 
          self_employed  => 0, 
          married        => 0, 
          sex            => 'f' });
          
    # or
    
    $ni = Algorithm::NIN::calculateNI({ 
          fiscal_year    => '2010-11', 
          gross_per_week => 450, 
          self_employed  => 0, 
          married        => 1, 
          sex            => 'f' });

=cut

sub calculateNI
{
    my $param = shift;
    craok("ERROR: No input provided for NI contribution calculation.\n")
        unless defined $param;

    _validate_param($param);

    if (exists($param->{class}) && ($param->{class} == 3))
    {
        return _format_amount($TABLE->{$param->{fiscal_year}}->{CLASS_3_FLAT_PW});
    }

    if (defined($param->{gross_per_week}))
    {
        print "Gross per week [".$param->{gross_per_week}."]\n" if $DEBUG;
    }

    if (exists($param->{self_employed}) && ($param->{self_employed} == 0))
    {
        if (exists($param->{sex}) && ($param->{sex} =~ /F|f/))
        {
            if (exists($param->{married}) && ($param->{married}))
            {
                return _calculateNI($param->{gross_per_week}, 
                                    $param->{fiscal_year}, 
                                    $TABLE->{$param->{fiscal_year}}->{PRIMARY_THRESHOLD_PW},
                                    $TABLE->{$param->{fiscal_year}}->{UPPER_EARNINGS_LIMIT_PW},
                                    $param->{self_employed},
                                    1);
            }
            else
            {
                return _calculateNI($param->{gross_per_week}, 
                                    $param->{fiscal_year}, 
                                    $TABLE->{$param->{fiscal_year}}->{PRIMARY_THRESHOLD_PW},
                                    $TABLE->{$param->{fiscal_year}}->{UPPER_EARNINGS_LIMIT_PW},
                                    $param->{self_employed},
                                    0);
            }
        }
        else
        {
            return _calculateNI($param->{gross_per_week}, 
                                $param->{fiscal_year}, 
                                $TABLE->{$param->{fiscal_year}}->{PRIMARY_THRESHOLD_PW},
                                $TABLE->{$param->{fiscal_year}}->{UPPER_EARNINGS_LIMIT_PW},
                                $param->{self_employed},
                                0);
        }
    }
    else
    {
        return _format_amount($TABLE->{$param->{fiscal_year}}->{CLASS_2_FLAT_PW})
            if (exists($param->{class}) && ($param->{class} == 2));

        return _calculateNI($param->{annual_profit},
                            $param->{fiscal_year}, 
                            $TABLE->{$param->{fiscal_year}}->{CLASS_4_LOWER_PROFIT_LIMIT_PA},
                            $TABLE->{$param->{fiscal_year}}->{CLASS_4_UPPER_PROFIT_LIMIT_PA},
                            $param->{self_employed},
                            0);
    }
}

sub _calculateNI
{
    my $gross_amount  = shift;
    my $fiscal_year   = shift;
    my $lower_limit   = shift;
    my $upper_limit   = shift;
    my $self_employed = shift;
    my $married_women = shift;

    if (defined($gross_amount) && defined($lower_limit) && ($gross_amount < $lower_limit))
    {
        return 0;
    }
    else
    {
        my ($rate_a, $rate_b);
        $rate_a = $TABLE->{$fiscal_year}->{CLASS_1_RATE_A};
        $rate_a = $TABLE->{$fiscal_year}->{MARRIED_WOMEN_RATE_A}
            if ($married_women);
        $rate_a = $TABLE->{$fiscal_year}->{CLASS_4_RATE_A}
            if $self_employed;
        print "Applying RATE A [$rate_a]\n" if $DEBUG;
        
        if (defined($gross_amount) && defined($upper_limit) && ($gross_amount < $upper_limit))
        {
            return _format_amount((($gross_amount - $lower_limit) * $rate_a));
        }
        else
        {
            $rate_b  = $TABLE->{$fiscal_year}->{CLASS_1_RATE_B};        
            $rate_b = $TABLE->{$fiscal_year}->{MARRIED_WOMEN_RATE_B}
                if ($married_women);
            $rate_b = $TABLE->{$fiscal_year}->{CLASS_4_RATE_B}
                if $self_employed;
            print "Applying RATE B [$rate_b]\n" if $DEBUG;            

            my $level_1 = $upper_limit - $lower_limit;
            my $level_2 = $gross_amount - $upper_limit;
            return _format_amount(($level_1 * $rate_a) + ($level_2 * ($rate_a + $rate_b)));
        }
    }
}

# Checks the param is a HASHREF.
# Compare keys of the hash with the list $VALID_PARAM.
# Check if FISCAL YEAR is provided.
# Check if ANNUAL PROFIT is provided when CLASS is set to 4.
# Check if MARITAL STATUS is provided when SEX is set to F/f.
# Check if CLASS is set to either 2, 3 or 4.
# Check if GROSS PER WEEK is provided when no CLASS found.
# Check if FISCAL YEAR is in the format YYYY-YY.
# Check if GROSS PER WEEK/ANNUAL PROFIT is real number.
sub _validate_param
{
    my $param = shift;

    print Dumper($param);
    croak("ERROR: Param has to be reference to a HASH.\n")
        unless ref($param) eq 'HASH';
        
    foreach my $key (keys %{$param})
    {
        croak("ERROR: Invalid key [$key] found in the param.\n")
            unless grep(/^$key$/,@VALID_PARAM);
    }
    
    croak("ERROR: Fiscal year key is missing.\n")
        unless defined($param->{fiscal_year});
    croak("ERROR: Annual profit is missing.\n")
        if (defined($param->{class}) && ($param->{class} == 4) && !defined($param->{annual_profit}));
    croak("ERROR: Gross salary is missing.\n")
        if (defined($param->{class}) && ($param->{class} == 1) && !defined($param->{gross_per_week}));
    croak("ERROR: Marital status is missing.\n")
        if (defined($param->{sex}) && ($param->{sex} =~ /F|f/i) && !defined($param->{married}));
    croak("ERROR: Invalid class provided.\n")
        if (defined($param->{self_employed}) && ($param->{self_employed} == 0) && 
            defined($param->{class}) && ($param->{class} =~ /2|3|4/));
    croak("ERROR: Missing gross per week salary.\n")
        if (!defined($param->{class}) && !defined($param->{gross_per_week}));
    croak("ERROR: Invalid fiscal year.\n")
        unless defined($TABLE->{$param->{fiscal_year}});
        
    croak("ERROR: Invalid gross per week salary.\n")
        if (defined($param->{gross_per_week}) && ($param->{gross_per_week} !~ /^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$/));
    croak("ERROR: Invalid annual profit.\n")
        if (defined($param->{annual_profit}) && ($param->{annual_profit} !~ /^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$/));
}

sub _format_amount
{
    my $amount = shift;
    return sprintf("%.02f", $amount);
}

sub _error
{
    my $message = shift;
    return "ERROR: Validation failed [$message].\n";
}

=head1 AUTHOR

Mohammad S Anwar, C<< <mohammad.anwar at yahoo.com> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-algorithm-nin at rt.cpan.org>,  or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Algorithm-NIN>.I will be 
notified, and then you'll automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Algorithm::NIN

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Algorithm-NIN>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Algorithm-NIN>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Algorithm-NIN>

=item * Search CPAN

L<http://search.cpan.org/dist/Algorithm-NIN/>

=back

=head1 TODO

Following NI contributions scenarios are NOT yet covered.

=over 4

=item * Employer's contracted-out rebate, money-purchase schemes

=item * Employer's contracted-out rebate, salary-related schemes

=item * Employee's contracted-out rebate

=item * Special Class 2 rate for share fishermen

=item * Additional primary Class 1 percentage rate on deferred employments

=item * Additional Class 4 percentage rate where deferment has been granted

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2011 Mohammad S Anwar.

This  program  is  free  software; you can redistribute it and/or modify it under the terms of
either:  the  GNU  General Public License as published by the Free Software Foundation; or the
Artistic License.

See http://dev.perl.org/licenses/ for more information.

=head1 DISCLAIMER

This  program  is  distributed in the hope that it will be useful,  but  WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

=cut

1; # End of Algorithm::NIN