File Coverage

blib/lib/Geo/UK/Postcode/Regex.pm

Criterion	Covered	Total	%
statement	90	90	100.0
branch	65	74	87.8
condition	11	13	84.6
subroutine	21	21	100.0
pod	16	16	100.0
total	203	214	94.8

package Geo::UK::Postcode::Regex;

use strict;
use warnings;

use Geo::UK::Postcode::Regex::Hash;

use base 'Exporter';
our @EXPORT_OK = qw( is_valid_pc is_strict_pc is_lax_pc %REGEXES );

our $VERSION = '0.017';

=encoding utf-8

=head1 NAME

Geo::UK::Postcode::Regex - regular expressions for handling British postcodes

=head1 SYNOPSIS

See L for an alternative interface.

    use Geo::UK::Postcode::Regex;

    ## REGULAR EXPRESSIONS

    my $lax_re    = Geo::UK::Postcode::Regex->regex;
    my $strict_re = Geo::UK::Postcode::Regex->strict_regex;
    my $valid_re  = Geo::UK::Postcode::Regex->valid_regex;

    # matching only
    if ( $foo =~ $lax_re )    {...}
    if ( $foo =~ $strict_re ) {...}
    if ( $foo =~ $valid_re )  {...}

    # matching and using components - see also parse()
    if ( $foo =~ $lax_re ) {
        my ( $area, $district, $sector, $unit ) = ( $1, $2, $3, $4 );
        my $subdistrict = $district =~ s/([A-Z])$// ? $1 : undef;
        ...
    }
    if ( $foo =~ $strict_re ) {
        my ( $area, $district, $sector, $unit ) = ( $1, $2, $3, $4 );
        my $subdistrict = $district =~ s/([A-Z])$// ? $1 : undef;
        ...
    }
    if ( $foo =~ $valid_re ) {
        my ( $outcode, $sector, $unit ) = ( $1, $2, $3 );
        ...
    }


    ## VALIDATION METHODS

    use Geo::UK::Postcode::Regex qw( is_valid_pc is_strict_pc is_lax_pc );

    if (is_valid_pc("GE0 1UK")) {
        ...
    }
    if (is_strict_pc("GE0 1UK")) {
        ...
    }
    if (is_lax_pc("GE0 1UK")) {
        ...
    }


    ## PARSING

    my $parsed = Geo::UK::Postcode::Regex->parse("WC1H 9EB");

    # returns:
    # {   area             => 'WC',
    #     district         => '1',
    #     subdistrict      => 'H',
    #     sector           => '9',
    #     unit             => 'EB',
    #     outcode          => 'WC1H',
    #     incode           => '9EB',
    #     valid            => 1,
    #     strict           => 1,
    #     partial          => 0,
    #     non_geographical => 0,
    #     bfpo             => 0,
    # }

    # strict parsing (only valid characters):
    ...->parse( $pc, { strict => 1 } )

    # valid outcodes only
    ...->parse( $pc, { valid => 1 } )

    # match partial postcodes, e.g. 'WC1H', 'WC1H 9' - see below
    ...->parse( $pc, { partial => 1 } )


    ## PARSING PARTIAL POSTCODES

    # outcode (district) only
    my $parsed = Geo::UK::Postcode::Regex->parse( "AB10", { partial => 1 } );

    # returns:
    # {   area             => 'AB',
    #     district         => '10',
    #     subdistrict      => undef,
    #     sector           => undef,
    #     unit             => undef,
    #     outcode          => 'AB10',
    #     incode           => undef,
    #     valid            => 1,
    #     strict           => 1,
    #     partial          => 1,
    #     non_geographical => 0,
    #     bfpo             => 0,
    # }

    # sector only
    my $parsed = Geo::UK::Postcode::Regex->parse( "AB10 1", { partial => 1 } );

    # returns:
    # {   area             => 'AB',
    #     district         => '10',
    #     subdistrict      => undef,
    #     sector           => 1,
    #     unit             => undef,
    #     outcode          => 'AB10',
    #     incode           => '1',
    #     valid            => 1,
    #     strict           => 1,
    #     partial          => 1,
    #     non_geographical => 0,
    #     bfpo             => 0,
    # }


    ## EXTRACT OUTCODE FROM POSTCODE

    my $outcode = Geo::UK::Postcode::Regex->outcode("AB101AA"); # returns 'AB10'

    my $outcode = Geo::UK::Postcode::Regex->outcode( $postcode, { valid => 1 } )
        or die "Invalid postcode";


    ## EXTRACT POSTCODES FROM TEXT

    # \%options as per parse, excluding partial
    my @extracted = Geo::UK::Postcode::Regex->extract( $text, \%options );


    ## POSTTOWNS
    my @posttowns = Geo::UK::Postcode::Regex->outcode_to_posttowns($outcode);


    ## OUTCODES
    my @outcodes = Geo::UK::Postcode::Regex->posttown_to_outcodes($posttown);


=head1 DESCRIPTION

Parsing UK postcodes with regular expressions (aka Regexp). This package has
been separated from L so it can be installed and used with
fewer dependencies.

Can handle partial postcodes (just the outcode or sector) and can test
against valid characters and currently valid outcodes.

Also can determine the posttown(s) from a postcode.

Districts and post town information taken from:
L

=head1 IMPORTANT CHANGES FOR VERSION 0.014

Please note that various bugfixes have changed the following:

=over

=item *

Unanchored regular expressions no longer match valid postcodes within invalid
ones.

=item *

Unanchored regular expressions in partial mode now can match a valid or strict
outcode with an invalid incode.

=back

Please get in touch if you have any questions.

See L for other changes affecting the Simple
interface.

=head1 NOTES AND LIMITATIONS

When parsing a partial postcode, whitespace may be required to separate the
outcode from the sector.

For example the sector 'B1 1' cannot be distinguished from the district 'B11'
without whitespace. This is not a problem when parsing full postcodes.

=cut

## REGULAR EXPRESSIONS

my $AREA1 = 'ABCDEFGHIJKLMNOPRSTUWYZ';    # [^QVX]
my $AREA2 = 'ABCDEFGHKLMNOPQRSTUVWXY';    # [^IJZ]

my $SUBDISTRICT1 = 'ABCDEFGHJKPSTUW';      # for single letter areas
my $SUBDISTRICT2 = 'ABEHMNPRVWXY';         # for two letter areas

my $UNIT1 = 'ABDEFGHJLNPQRSTUWXYZ';        # [^CIKMOV]
my $UNIT2 = 'ABDEFGHJLNPQRSTUWXYZ';        # [^CIKMOV]

our %COMPONENTS = (
    strict => {
        area     => "[$AREA1][$AREA2]?",
        district => qq% (?:
                            [0-9][0-9]?
            | (?
            | (?<=[A-Z]{2}) [0-9][$SUBDISTRICT2]
        ) %,
        sector => '[0-9]',
        unit   => "[$UNIT1][$UNIT2]",
        blank  => '',
    },
    lax => {
        area     => '[A-Z]{1,2}',
        district => '[0-9](?:[0-9]|[A-Z])?',
        sector   => '[0-9]',
        unit     => '[A-Z]{2}',
    },
);

my %BASE_REGEXES = (
    full          => ' %s %s     \s* %s    %s       ',
    partial       => ' %s %s (?: \s* %s (?:%s)? ) ? ',
);

my ( %POSTTOWNS, %OUTCODES );

tie our %REGEXES, 'Geo::UK::Postcode::Regex::Hash', _fetch => sub {
    my ($key) = @_;

    _outcode_data() if $key =~ m/valid/ && !%OUTCODES;

    my $type = $key =~ m/lax/ ? 'lax' : 'strict';

    my $components = $Geo::UK::Postcode::Regex::COMPONENTS{$type};

    my @comps
        = $key =~ m/valid/
        ? @{$components}{qw( outcodes blank sector unit )}
        : @{$components}{qw( area district sector unit )};

    @comps = map { $_ ? "($_)" : $_ } @comps if $key =~ m/captures/;

    my $size = $key =~ m/partial/ ? 'partial' : 'full';

    my $re = sprintf( $BASE_REGEXES{$size}, @comps );

    if ( $key =~ m/anchored/ ) {
        $re = '^' . $re . '$';

    } elsif ( $key =~ m/extract/ ) {
        $re = '(?:[^0-9A-Z]|\b) (' . $re . ') (?:[^0-9A-Z]|\b)';

    } else {
        $re = '(?:[^0-9A-Z]|\b) ' . $re . ' (?:[^0-9A-Z]|\b)';
    }

    return $key =~ m/case-insensitive/ ? qr/$re/ix : qr/$re/x;
};

## OUTCODE AND POSTTOWN DATA

sub _outcode_data {
    my %area_districts;

    # get the original position in the DATA File Handle
    my $orig_position = tell( DATA );
    # Get outcodes from __DATA__
    while ( my $line =  ) {
        next unless $line =~ m/\w/;
        chomp $line;
        my ( $outcode, $non_geographical, @posttowns ) = split /,/, $line;

        push @{ $POSTTOWNS{$_} }, $outcode foreach @posttowns;
        $OUTCODES{$outcode} = {
            posttowns        => \@posttowns,
            non_geographical => $non_geographical,
        };
    }
    # Reset position of DATA File Handle for re-reading
    seek DATA, $orig_position, 0;

    # Add in BX non-geographical outcodes
    foreach ( 1 .. 99 ) {
        $OUTCODES{ 'BX' . $_ } = {
            posttowns        => [],
            non_geographical => 1,
        };
    }

    foreach my $outcode ( sort keys %OUTCODES ) {
        my ( $area, $district )
            = $outcode =~ $REGEXES{strict_partial_anchored_captures}
            or next;

        $district = " $district" if length $district < 2;

        push @{ $area_districts{$area}->{ substr( $district, 0, 1 ) } },
            substr( $district, 1, 1 );
    }

    $Geo::UK::Postcode::Regex::COMPONENTS{strict}->{outcodes} = '(?: ' . join(
        "|\n",
        map {
            my $area = $_;
            sprintf(
                "%s (?:%s)",    #
                $area,
                join(
                    ' | ',
                    map {
                        sprintf( "%s[%s]",
                            $_, join( '', @{ $area_districts{$area}->{$_} } ) )
                        }       #
                        sort { $a eq ' ' ? 1 : $b eq ' ' ? -1 : $a <=> $b }
                        keys %{ $area_districts{$area} }
                )
                )
        } sort keys %area_districts
    ) . ' )';

}

=head1 VALIDATION METHODS

The following methods are for validating postcodes to various degrees.

L may provide a more convenient way of using
and customising these.

=head2 regex, strict_regex, valid_regex

Return regular expressions to parse postcodes and capture the constituent
parts: area, district, sector and unit (or outcode, sector and unit in the
case of C).

C checks that the postcode only contains valid characters
according to the postcode specifications.

C checks that the outcode currently exists.

=head2 regex_partial, strict_regex_partial, valid_regex_partial

As above, but matches on partial postcodes of just the outcode
or sector

=cut

sub valid_regex_partial  { $REGEXES{valid_partial_anchored_captures} }
sub strict_regex_partial { $REGEXES{strict_partial_anchored_captures} }
sub regex_partial        { $REGEXES{lax_partial_anchored_captures} }
sub valid_regex          { $REGEXES{valid_anchored_captures} }
sub strict_regex         { $REGEXES{strict_anchored_captures} }
sub regex                { $REGEXES{lax_anchored_captures} }


=head2 is_valid_pc, is_strict_pc, is_lax_pc

    if (is_valid_pc( "AB1 2CD" ) ) { ... }

Alternative way to access the regexes.

=cut

sub is_valid_pc {
    my $pc = @_ > 1 ? $_[1] : $_[0]; # back-compat: can call as class method
    return $pc =~ $REGEXES{valid_anchored} ? 1 : 0
}
sub is_strict_pc {
    my $pc = @_ > 1 ? $_[1] : $_[0]; # back-compat: can call as class method
    return $pc =~ $REGEXES{strict_anchored} ? 1 : 0
}
sub is_lax_pc {
    my $pc = @_ > 1 ? $_[1] : $_[0]; # back-compat: can call as class method
    return $pc =~ $REGEXES{lax_anchored} ? 1 : 0
}

=head1 PARSING METHODS

The following methods are for parsing postcodes or strings containing postcodes.

=head2 PARSING_OPTIONS

The parsing methods can take the following options, passed via a hashref:

=over

=item strict

Postcodes must not contain invalid characters according to the postcode
specification. For example a 'Q' may not appear as the first character.

=item valid

Postcodes must contain an outcode (area + district) that currently exists, in
addition to conforming to the C definition.

Returns false if string is not a currently existing outcode.

=item partial

Allows partial postcodes to be matched. In practice this means either an outcode
( area and district ) or an outcode together with the sector.

=back

=head2 extract

    my @extracted = Geo::UK::Postcode::Regex->extract( $string, \%options );

Returns a list of full postcodes extracted from a string.

=cut

# TODO need to/can do partial?

sub extract {
    my ( $class, $string, $options ) = @_;

    _outcode_data() unless %OUTCODES;

    my $key
        = $options->{valid}  ? 'valid'
        : $options->{strict} ? 'strict'
        :                      'lax';

    $key .= '_case-insensitive' if $options->{'case-insensitive'};
    $key .= '_extract';

    my @extracted = $string =~ m/$REGEXES{$key}/g;

    return map {uc} @extracted;
}

=head2 parse

    my $parsed = Geo::UK::Postcode::Regex->parse( $pc, \%options );

Returns hashref of the constituent parts - see SYNOPSIS. Missing parts will be
set as undefined.

=cut

sub parse {
    my ( $class, $string, $options ) = @_;

    $options ||= {};

    $string = uc $string if $options->{'case-insensitive'};

    my $re
        = $options->{partial}
        ? 'partial_anchored_captures'
        : 'anchored_captures';

    my ( $area, $district, $sector, $unit ) = $string =~ $REGEXES{"strict_$re"};

    my $strict = $area ? 1 : 0;    # matched strict?

    unless ($strict) {
        return if $options->{strict};

        # try lax regex
        ( $area, $district, $sector, $unit ) = $string =~ $REGEXES{"lax_$re"}
            or return;
    }

    return unless $unit || $options->{partial};

    return unless defined $district;

    my $outcode      = $area . $district;
    my $outcode_data = $class->outcodes_lookup->{$outcode};

    return if $options->{valid} && !$outcode_data;

    my $subdistrict = $district =~ s/([A-Z])$// ? $1 : undef;

    my $incode = $unit ? "$sector$unit" : $sector ? $sector : undef;

    return {
        area        => $area,
        district    => $district,
        subdistrict => $subdistrict,
        sector      => $sector,
        unit        => $unit,
        outcode     => $outcode,
        incode      => $incode,

        strict  => $strict,
        partial => $unit ? 0 : 1,
        valid   => $outcode_data && $strict ? 1 : 0,

        $outcode_data->{non_geographical} ? ( non_geographical => 1 ) : (),
        $outcode eq "BF1"                 ? ( bfpo             => 1 ) : (),
    };
}

=head2 outcode

    my $outcode = Geo::UK::Postcode::Regex->outcode( $pc, \%options );

Extract the outcode (area and district) from a postcode string. Will work on
full or partial postcodes.

=cut

sub outcode {
    my ( $class, $string, $options ) = @_;

    my $parsed = $class->parse( $string, { partial => 1, %{ $options || {} } } )
        or return;

    return $parsed->{outcode};
}

=head1 LOOKUP METHODS

=head2 outcode_to_posttowns

    my ( $posttown1, $posttown2, ... )
        = Geo::UK::Postcode::Regex->outcode_to_posttowns($outcode);

Returns posttown(s) for supplied outcode.

Note - most outcodes will only have one posttown, but some are shared between
two posttowns.

=cut

sub outcode_to_posttowns {
    my ( $class, $outcode ) = @_;

    my $data = $class->outcodes_lookup->{$outcode};

    return @{ $data ? $data->{posttowns} : [] };
}

=head2 posttown_to_outcodes

    my @outcodes = Geo::UK::Postcode::Regex->posttown_to_outcodes($posttown);

Returns the outcodes covered by a posttown. Note some outcodes are shared
between posttowns.

=cut

sub posttown_to_outcodes {
    my ( $class, $posttown ) = @_;

    return @{ $class->posttowns_lookup->{ $posttown || '' } || [] };
}

=head2 outcodes_lookup

    my %outcodes = %{ Geo::UK::Postcode::Regex->outcodes_lookup };
    print "valid outcode" if $outcodes{$outcode};
    my @posttowns = @{ $outcodes{$outcode} };

Hashref of outcodes to posttown(s);

=head2 posttowns_lookup

    my %posttowns = %{ Geo::UK::Postcode::Regex->posttowns_lookup };
    print "valid posttown" if $posttowns{$posttown};
    my @outcodes = @{ $[posttowns{$posttown} };

Hashref of posttown to outcode(s);

=cut

sub outcodes_lookup {
    my $class = shift;

    _outcode_data() unless %OUTCODES;

    return \%OUTCODES;
}

sub posttowns_lookup {
    my $class = shift;

    _outcode_data() unless %POSTTOWNS;

    return \%POSTTOWNS;
}

=head1 SEE ALSO

=over

=item *

L - companion package, provides Postcode objects

=item *

L

=item *

L

=item *

L

=item *

L

=item *

L

=back

=head1 SUPPORT

=head2 Bugs / Feature Requests

Please report any bugs or feature requests through the issue tracker
at L.
You will be notified automatically of any progress on your issue.

=head2 Source Code

This is open source software.  The code repository is available for
public review and contribution under the terms of the license.

L

    git clone git://github.com/mjemmeson/geo-uk-postcode-regex.git

=head1 AUTHOR

Michael Jemmeson [e-mail]

=head1 CONTRIBUTORS

=over

=item *

Tom Bloor C

=back

=head1 COPYRIGHT

Copyright 2015-2017 Michael Jemmeson

=head1 LICENSE

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

=cut

1;

__DATA__