File Coverage

blib/lib/Eircode.pm

Criterion	Covered	Total	%
statement	50	52	96.1
branch	16	18	88.8
condition	4	5	80.0
subroutine	9	9	100.0
pod	3	4	75.0
total	82	88	93.1

use utf8;
# ABSTRACT: Validation and utilities for Eircodes / Irish postcodes
package Eircode;

# Check Eircodes / Irish postcodes


use strict;
use Carp;
use Const::Fast;
use parent qw< Exporter >;

our @EXPORT_OK = ( qw<
                         check_eircode
                         normalise_eircode
                         split_eircode
                     > );
our $VERSION = "0.2.0";



sub check_eircode{
    my( $data, $opt, @x ) = @_;
    if( scalar @x ) {
        croak 'Usage check_eircode($data, {});';
    }

    $opt ||= {};

    my $strict = $opt->{strict};
    my $lax = $opt->{lax};
    my $space_optional = $opt->{space_optional};
    my @options = grep{$_} ($strict, $lax, $space_optional);

    if( scalar @options > 1){
        croak q{Can't combine options for strict/lax/space_optional at the moment};
    }

    if( $lax ){
        $data =~ tr/[ ]//d;
    }

    unless($strict){
        $data = uc($data);
    }

    $data or return;

    my $re = build_re($opt);
    if( $strict ){
        return $data =~ /$re/;
    }
    else{
        return $data =~ /$re/i;
    }

}

const my $EIR_LETTER => 'A-NP-Z';
const my $LETTER_CLASS => "[$EIR_LETTER]";
const my $EIR_ANY => "[$EIR_LETTER\\d]";
const my $ROUTING_KEY => "${LETTER_CLASS}${EIR_ANY}{2}";
const my $UID => "${EIR_ANY}{4}";

sub build_re{
    my($opt) = @_;
    my $lax = $opt->{lax};
    my $space_optional = $opt->{space_optional};

    my $re;
    if( $lax ){
        $re = qr{^$ROUTING_KEY$UID$};
    }
    elsif( $space_optional ){
        $re = qr{^$ROUTING_KEY\s*$UID$};
    }
    else{
        $re = qr{^$ROUTING_KEY\s+$UID$};
    }

}

sub normalise_eircode{
    my($input) = @_;
    $input = uc $input;
    $input =~ tr/ \t//d;
    my($routing_key, $uid) = split_eircode($input);
    return "$routing_key $uid";
}


sub split_eircode{
    my($input) = @_;
    my( $routing_key, $uid ) = ($input =~ /^($ROUTING_KEY)\s*($UID)$/i);
    $routing_key && $uid or die 'invalid eircode';
    return ($routing_key, $uid);
}


;1

__END__