File Coverage

blib/lib/Geo/UK/Postcode/Regex.pm
Criterion Covered Total %
statement 88 88 100.0
branch 65 74 87.8
condition 10 13 76.9
subroutine 21 21 100.0
pod 16 16 100.0
total 200 212 94.3


line stmt bran cond sub pod time code
1             package Geo::UK::Postcode::Regex;
2              
3 7     7   142941 use strict;
  7         13  
  7         13484  
4 7     7   73 use warnings;
  7         13  
  7         307  
5              
6 7     7   15800 use Geo::UK::Postcode::Regex::Hash;
  7         18  
  7         361  
7              
8 7     7   53 use base 'Exporter';
  7         20  
  7         18674  
9             our @EXPORT_OK = qw( is_valid_pc is_strict_pc is_lax_pc %REGEXES );
10              
11             our $VERSION = '0.015';
12              
13             =encoding utf-8
14              
15             =head1 NAME
16              
17             Geo::UK::Postcode::Regex - regular expressions for handling British postcodes
18              
19             =head1 SYNOPSIS
20              
21             See L for an alternative interface.
22              
23             use Geo::UK::Postcode::Regex;
24              
25             ## REGULAR EXPRESSIONS
26              
27             my $lax_re = Geo::UK::Postcode::Regex->regex;
28             my $strict_re = Geo::UK::Postcode::Regex->regex_strict;
29             my $valid_re = Geo::UK::Postcode::Regex->valid_regex;
30              
31             # matching only
32             if ( $foo =~ $lax_re ) {...}
33             if ( $foo =~ $strict_re ) {...}
34             if ( $foo =~ $valid_re ) {...}
35              
36             # matching and using components - see also parse()
37             if ( $foo =~ $lax_re ) {
38             my ( $area, $district, $sector, $unit ) = ( $1, $2, $3, $4 );
39             my $subdistrict = $district =~ s/([A-Z])$// ? $1 : undef;
40             ...
41             }
42             if ( $foo =~ $strict_re ) {
43             my ( $area, $district, $sector, $unit ) = ( $1, $2, $3, $4 );
44             my $subdistrict = $district =~ s/([A-Z])$// ? $1 : undef;
45             ...
46             }
47             if ( $foo =~ $valid_re ) {
48             my ( $outcode, $sector, $unit ) = ( $1, $2, $3 );
49             ...
50             }
51              
52              
53             ## VALIDATION METHODS
54              
55             use Geo::UK::Postcode::Regex qw( is_valid_pc is_strict_pc is_lax_pc );
56              
57             if (is_valid_pc("GE0 1UK")) {
58             ...
59             }
60             if (is_strict_pc("GE0 1UK")) {
61             ...
62             }
63             if (is_lax_pc("GE0 1UK")) {
64             ...
65             }
66              
67              
68             ## PARSING
69              
70             my $parsed = Geo::UK::Postcode::Regex->parse("WC1H 9EB");
71              
72             # returns:
73             # { area => 'WC',
74             # district => '1',
75             # subdistrict => 'H',
76             # sector => '9',
77             # unit => 'EB',
78             # outcode => 'WC1H',
79             # incode => '9EB',
80             # valid => 1,
81             # strict => 1,
82             # partial => 0,
83             # non_geographical => 0,
84             # bfpo => 0,
85             # }
86              
87             # strict parsing (only valid characters):
88             ...->parse( $pc, { strict => 1 } )
89              
90             # valid outcodes only
91             ...->parse( $pc, { valid => 1 } )
92              
93             # match partial postcodes, e.g. 'WC1H', 'WC1H 9' - see below
94             ...->parse( $pc, { partial => 1 } )
95              
96              
97             ## PARSING PARTIAL POSTCODES
98              
99             # outcode (district) only
100             my $parsed = Geo::UK::Postcode::Regex->parse( "AB10", { partial => 1 } );
101              
102             # returns:
103             # { area => 'AB',
104             # district => '10',
105             # subdistrict => undef,
106             # sector => undef,
107             # unit => undef,
108             # outcode => 'AB10',
109             # incode => undef,
110             # valid => 1,
111             # strict => 1,
112             # partial => 1,
113             # non_geographical => 0,
114             # bfpo => 0,
115             # }
116              
117             # sector only
118             my $parsed = Geo::UK::Postcode::Regex->parse( "AB10 1", { partial => 1 } );
119              
120             # returns:
121             # { area => 'AB',
122             # district => '10',
123             # subdistrict => undef,
124             # sector => 1,
125             # unit => undef,
126             # outcode => 'AB10',
127             # incode => '1',
128             # valid => 1,
129             # strict => 1,
130             # partial => 1,
131             # non_geographical => 0,
132             # bfpo => 0,
133             # }
134              
135              
136             ## EXTRACT OUTCODE FROM POSTCODE
137              
138             my $outcode = Geo::UK::Postcode::Regex->outcode("AB101AA"); # returns 'AB10'
139              
140             my $outcode = Geo::UK::Postcode::Regex->outcode( $postcode, { valid => 1 } )
141             or die "Invalid postcode";
142              
143              
144             ## EXTRACT POSTCODES FROM TEXT
145              
146             # \%options as per parse, excluding partial
147             my @extracted = Geo::UK::Postcode::Regex->extract( $text, \%options );
148              
149              
150             ## POSTTOWNS
151             my @posttowns = Geo::UK::Postcode::Regex->outcode_to_posttowns($outcode);
152              
153              
154             ## OUTCODES
155             my @outcodes = Geo::UK::Postcode::Regex->posttown_to_outcodes($posttown);
156              
157              
158             =head1 DESCRIPTION
159              
160             Parsing UK postcodes with regular expressions. This package has been
161             separated from L so it can be installed and used with fewer
162             dependencies.
163              
164             Can handle partial postcodes (just the outcode or sector) and can test
165             against valid characters and currently valid outcodes.
166              
167             Also can determine the posttown(s) from a postcode.
168              
169             Districts and post town information taken from:
170             L
171              
172             =head1 IMPORTANT CHANGES FOR VERSION 0.014
173              
174             Please note that various bugfixes have changed the following:
175              
176             =over
177              
178             =item *
179              
180             Unanchored regular expressions no longer match valid postcodes within invalid
181             ones.
182              
183             =item *
184              
185             Unanchored regular expressions in partial mode now can match a valid or strict
186             outcode with an invalid incode.
187              
188             =back
189              
190             Please get in touch if you have any questions.
191              
192             See L for other changes affecting the Simple
193             interface.
194              
195             =head1 NOTES AND LIMITATIONS
196              
197             When parsing a partial postcode, whitespace may be required to separate the
198             outcode from the sector.
199              
200             For example the sector 'B1 1' cannot be distinguished from the district 'B11'
201             without whitespace. This is not a problem when parsing full postcodes.
202              
203             =cut
204              
205             ## REGULAR EXPRESSIONS
206              
207             my $AREA1 = 'ABCDEFGHIJKLMNOPRSTUWYZ'; # [^QVX]
208             my $AREA2 = 'ABCDEFGHKLMNOPQRSTUVWXY'; # [^IJZ]
209              
210             my $SUBDISTRICT1 = 'ABCDEFGHJKPSTUW'; # for single letter areas
211             my $SUBDISTRICT2 = 'ABEHMNPRVWXY'; # for two letter areas
212              
213             my $UNIT1 = 'ABDEFGHJLNPQRSTUWXYZ'; # [^CIKMOV]
214             my $UNIT2 = 'ABDEFGHJLNPQRSTUWXYZ'; # [^CIKMOV]
215              
216             our %COMPONENTS = (
217             strict => {
218             area => "[$AREA1][$AREA2]?",
219             district => qq% (?:
220             [0-9][0-9]?
221             | (?
222             | (?<=[A-Z]{2}) [0-9][$SUBDISTRICT2]
223             ) %,
224             sector => '[0-9]',
225             unit => "[$UNIT1][$UNIT2]",
226             blank => '',
227             },
228             lax => {
229             area => '[A-Z]{1,2}',
230             district => '[0-9](?:[0-9]|[A-Z])?',
231             sector => '[0-9]',
232             unit => '[A-Z]{2}',
233             },
234             );
235              
236             my %BASE_REGEXES = (
237             full => ' %s %s \s* %s %s ',
238             partial => ' %s %s (?: \s* %s (?:%s)? ) ? ',
239             );
240              
241             my ( %POSTTOWNS, %OUTCODES );
242              
243             tie our %REGEXES, 'Geo::UK::Postcode::Regex::Hash', _fetch => sub {
244             my ($key) = @_;
245              
246             _outcode_data() if $key =~ m/valid/ && !%OUTCODES;
247              
248             my $type = $key =~ m/lax/ ? 'lax' : 'strict';
249              
250             my $components = $Geo::UK::Postcode::Regex::COMPONENTS{$type};
251              
252             my @comps
253             = $key =~ m/valid/
254             ? @{$components}{qw( outcodes blank sector unit )}
255             : @{$components}{qw( area district sector unit )};
256              
257             @comps = map { $_ ? "($_)" : $_ } @comps if $key =~ m/captures/;
258              
259             my $size = $key =~ m/partial/ ? 'partial' : 'full';
260              
261             my $re = sprintf( $BASE_REGEXES{$size}, @comps );
262              
263             if ( $key =~ m/anchored/ ) {
264             $re = '^' . $re . '$';
265              
266             } elsif ( $key =~ m/extract/ ) {
267             $re = '(?:[^0-9A-Z]|\b) (' . $re . ') (?:[^0-9A-Z]|\b)';
268              
269             } else {
270             $re = '(?:[^0-9A-Z]|\b) ' . $re . ' (?:[^0-9A-Z]|\b)';
271             }
272              
273             return $key =~ m/case-insensitive/ ? qr/$re/ix : qr/$re/x;
274             };
275              
276             ## OUTCODE AND POSTTOWN DATA
277              
278             sub _outcode_data {
279 6     6   11 my %area_districts;
280              
281             # Get outcodes from __DATA__
282 6         37 while ( my $line = ) {
283 17940 100       52942 next unless $line =~ m/\w/;
284 17934         22233 chomp $line;
285 17934         55429 my ( $outcode, $non_geographical, @posttowns ) = split /,/, $line;
286              
287 17934         26162 push @{ $POSTTOWNS{$_} }, $outcode foreach @posttowns;
  18684         71514  
288 17934         118167 $OUTCODES{$outcode} = {
289             posttowns => \@posttowns,
290             non_geographical => $non_geographical,
291             };
292             }
293              
294             # Add in BX non-geographical outcodes
295 6         26 foreach ( 1 .. 99 ) {
296 594         2016 $OUTCODES{ 'BX' . $_ } = {
297             posttowns => [],
298             non_geographical => 1,
299             };
300             }
301              
302 6         23247 foreach my $outcode ( sort keys %OUTCODES ) {
303 18528 50       68876 my ( $area, $district )
304             = $outcode =~ $REGEXES{strict_partial_anchored_captures}
305             or next;
306              
307 18528 100       57581 $district = " $district" if length $district < 2;
308              
309 18528         18915 push @{ $area_districts{$area}->{ substr( $district, 0, 1 ) } },
  18528         73501  
310             substr( $district, 1, 1 );
311             }
312              
313 756         886 $Geo::UK::Postcode::Regex::COMPONENTS{strict}->{outcodes} = '(?: ' . join(
314             "|\n",
315             map {
316 6         4318 my $area = $_;
317 2982         17745 sprintf(
318             "%s (?:%s)", #
319             $area,
320             join(
321             ' | ',
322             map {
323 4208 100       9366 sprintf( "%s[%s]",
    100          
324 2982         2833 $_, join( '', @{ $area_districts{$area}->{$_} } ) )
325             } #
326 756         3223 sort { $a eq ' ' ? 1 : $b eq ' ' ? -1 : $a <=> $b }
327 756         802 keys %{ $area_districts{$area} }
328             )
329             )
330             } sort keys %area_districts
331             ) . ' )';
332              
333             }
334              
335             =head1 VALIDATION METHODS
336              
337             The following methods are for validating postcodes to various degrees.
338              
339             L may provide a more convenient way of using
340             and customising these.
341              
342             =head2 regex, strict_regex, valid_regex
343              
344             Return regular expressions to parse postcodes and capture the constituent
345             parts: area, district, sector and unit (or outcode, sector and unit in the
346             case of C).
347              
348             C checks that the postcode only contains valid characters
349             according to the postcode specifications.
350              
351             C checks that the outcode currently exists.
352              
353             =head2 regex_partial, strict_regex_partial, valid_regex_partial
354              
355             As above, but matches on partial postcodes of just the outcode
356             or sector
357              
358             =cut
359              
360 1     1 1 10 sub valid_regex_partial { $REGEXES{valid_partial_anchored_captures} }
361 1     1 1 8 sub strict_regex_partial { $REGEXES{strict_partial_anchored_captures} }
362 1     1 1 12 sub regex_partial { $REGEXES{lax_partial_anchored_captures} }
363 1     1 1 7 sub valid_regex { $REGEXES{valid_anchored_captures} }
364 1     1 1 7 sub strict_regex { $REGEXES{strict_anchored_captures} }
365 1     1 1 27 sub regex { $REGEXES{lax_anchored_captures} }
366              
367              
368             =head2 is_valid_pc, is_strict_pc, is_lax_pc
369              
370             if (is_valid_pc( "AB1 2CD" ) ) { ... }
371              
372             Alternative way to access the regexes.
373              
374             =cut
375              
376             sub is_valid_pc {
377 61 50   61 1 53086 my $pc = @_ > 1 ? $_[1] : $_[0]; # back-compat: can call as class method
378 61 100       585 return $pc =~ $REGEXES{valid_anchored} ? 1 : 0
379             }
380             sub is_strict_pc {
381 61 50   61 1 411168 my $pc = @_ > 1 ? $_[1] : $_[0]; # back-compat: can call as class method
382 61 100       766 return $pc =~ $REGEXES{strict_anchored} ? 1 : 0
383             }
384             sub is_lax_pc {
385 61 50   61 1 41493 my $pc = @_ > 1 ? $_[1] : $_[0]; # back-compat: can call as class method
386 61 100       593 return $pc =~ $REGEXES{lax_anchored} ? 1 : 0
387             }
388              
389             =head1 PARSING METHODS
390              
391             The following methods are for parsing postcodes or strings containing postcodes.
392              
393             =head2 PARSING_OPTIONS
394              
395             The parsing methods can take the following options, passed via a hashref:
396              
397             =over
398              
399             =item strict
400              
401             Postcodes must not contain invalid characters according to the postcode
402             specification. For example a 'Q' may not appear as the first character.
403              
404             =item valid
405              
406             Postcodes must contain an outcode (area + district) that currently exists, in
407             addition to conforming to the C definition.
408              
409             Returns false if string is not a currently existing outcode.
410              
411             =item partial
412              
413             Allows partial postcodes to be matched. In practice this means either an outcode
414             ( area and district ) or an outcode together with the sector.
415              
416             =back
417              
418             =head2 extract
419              
420             my @extracted = Geo::UK::Postcode::Regex->extract( $string, \%options );
421              
422             Returns a list of full postcodes extracted from a string.
423              
424             =cut
425              
426             # TODO need to/can do partial?
427              
428             sub extract {
429 3606     3606 1 25512 my ( $class, $string, $options ) = @_;
430              
431 3606 100       9611 _outcode_data() unless %OUTCODES;
432              
433 3606 100       14175 my $key
    100          
434             = $options->{valid} ? 'valid'
435             : $options->{strict} ? 'strict'
436             : 'lax';
437              
438 3606 100       9621 $key .= '_case-insensitive' if $options->{'case-insensitive'};
439 3606         4976 $key .= '_extract';
440              
441 3606         32328 my @extracted = $string =~ m/$REGEXES{$key}/g;
442              
443 3606         17203 return map {uc} @extracted;
  2016         16908  
444             }
445              
446             =head2 parse
447              
448             my $parsed = Geo::UK::Postcode::Regex->parse( $pc, \%options );
449              
450             Returns hashref of the constituent parts - see SYNOPSIS. Missing parts will be
451             set as undefined.
452              
453             =cut
454              
455             sub parse {
456 4036     4036 1 3706888 my ( $class, $string, $options ) = @_;
457              
458 4036   50     12562 $options ||= {};
459              
460 4036 100       17647 $string = uc $string if $options->{'case-insensitive'};
461              
462 4036 100       16549 my $re
463             = $options->{partial}
464             ? 'partial_anchored_captures'
465             : 'anchored_captures';
466              
467 4036         29332 my ( $area, $district, $sector, $unit ) = $string =~ $REGEXES{"strict_$re"};
468              
469 4036 100       16599 my $strict = $area ? 1 : 0; # matched strict?
470              
471 4036 100       10805 unless ($strict) {
472 1635 100       8830 return if $options->{strict};
473              
474             # try lax regex
475 565 100       2631 ( $area, $district, $sector, $unit ) = $string =~ $REGEXES{"lax_$re"}
476             or return;
477             }
478              
479 2559 50 66     11670 return unless $unit || $options->{partial};
480              
481 2559 50       7254 return unless defined $district;
482              
483 2559         6432 my $outcode = $area . $district;
484 2559         12663 my $outcode_data = $class->outcodes_lookup->{$outcode};
485              
486 2559 100 100     16587 return if $options->{valid} && !$outcode_data;
487              
488 2336 100       17373 my $subdistrict = $district =~ s/([A-Z])$// ? $1 : undef;
489              
490 2336 100       8495 my $incode = $unit ? "$sector$unit" : $sector ? $sector : undef;
    100          
491              
492             return {
493 2336 100 100     59085 area => $area,
    100          
    100          
    100          
494             district => $district,
495             subdistrict => $subdistrict,
496             sector => $sector,
497             unit => $unit,
498             outcode => $outcode,
499             incode => $incode,
500              
501             strict => $strict,
502             partial => $unit ? 0 : 1,
503             valid => $outcode_data && $strict ? 1 : 0,
504              
505             $outcode_data->{non_geographical} ? ( non_geographical => 1 ) : (),
506             $outcode eq "BF1" ? ( bfpo => 1 ) : (),
507             };
508             }
509              
510             =head2 outcode
511              
512             my $outcode = Geo::UK::Postcode::Regex->outcode( $pc, \%options );
513              
514             Extract the outcode (area and district) from a postcode string. Will work on
515             full or partial postcodes.
516              
517             =cut
518              
519             sub outcode {
520 18     18 1 639 my ( $class, $string, $options ) = @_;
521              
522 18 100       26 my $parsed = $class->parse( $string, { partial => 1, %{ $options || {} } } )
  18 100       161  
523             or return;
524              
525 14         132 return $parsed->{outcode};
526             }
527              
528             =head1 LOOKUP METHODS
529              
530             =head2 outcode_to_posttowns
531              
532             my ( $posttown1, $posttown2, ... )
533             = Geo::UK::Postcode::Regex->outcode_to_posttowns($outcode);
534              
535             Returns posttown(s) for supplied outcode.
536              
537             Note - most outcodes will only have one posttown, but some are shared between
538             two posttowns.
539              
540             =cut
541              
542             sub outcode_to_posttowns {
543 2     2 1 1909 my ( $class, $outcode ) = @_;
544              
545 2         11 my $data = $class->outcodes_lookup->{$outcode};
546              
547 2 50       4 return @{ $data ? $data->{posttowns} : [] };
  2         38  
548             }
549              
550             =head2 posttown_to_outcodes
551              
552             my @outcodes = Geo::UK::Postcode::Regex->posttown_to_outcodes($posttown);
553              
554             Returns the outcodes covered by a posttown. Note some outcodes are shared
555             between posttowns.
556              
557             =cut
558              
559             sub posttown_to_outcodes {
560 1     1 1 1129 my ( $class, $posttown ) = @_;
561              
562 1 50 50     4 return @{ $class->posttowns_lookup->{ $posttown || '' } || [] };
  1         5  
563             }
564              
565             =head2 outcodes_lookup
566              
567             my %outcodes = %{ Geo::UK::Postcode::Regex->outcodes_lookup };
568             print "valid outcode" if $outcodes{$outcode};
569             my @posttowns = @{ $outcodes{$outcode} };
570              
571             Hashref of outcodes to posttown(s);
572              
573             =head2 posttowns_lookup
574              
575             my %posttowns = %{ Geo::UK::Postcode::Regex->posttowns_lookup };
576             print "valid posttown" if $posttowns{$posttown};
577             my @outcodes = @{ $[posttowns{$posttown} };
578              
579             Hashref of posttown to outcode(s);
580              
581             =cut
582              
583             sub outcodes_lookup {
584 2561     2561 1 4154 my $class = shift;
585              
586 2561 100       8188 _outcode_data() unless %OUTCODES;
587              
588 2561         10359 return \%OUTCODES;
589             }
590              
591             sub posttowns_lookup {
592 1     1 1 2 my $class = shift;
593              
594 1 50       7 _outcode_data() unless %POSTTOWNS;
595              
596 1         28 return \%POSTTOWNS;
597             }
598              
599             =head1 SEE ALSO
600              
601             =over
602              
603             =item *
604              
605             L
606              
607             =item *
608              
609             L
610              
611             =item *
612              
613             L
614              
615             =item *
616              
617             L
618              
619             =item *
620              
621             L
622              
623             =item *
624              
625             L
626              
627             =back
628              
629             =head1 SUPPORT
630              
631             =head2 Bugs / Feature Requests
632              
633             Please report any bugs or feature requests through the issue tracker
634             at L.
635             You will be notified automatically of any progress on your issue.
636              
637             =head2 Source Code
638              
639             This is open source software. The code repository is available for
640             public review and contribution under the terms of the license.
641              
642             L
643              
644             git clone git://github.com/mjemmeson/geo-uk-postcode-regex.git
645              
646             =head1 AUTHOR
647              
648             Michael Jemmeson Emjemmeson@cpan.orgE
649              
650             =head1 COPYRIGHT
651              
652             Copyright 2015- Michael Jemmeson
653              
654             =head1 LICENSE
655              
656             This library is free software; you can redistribute it and/or modify
657             it under the same terms as Perl itself.
658              
659             =cut
660              
661             1;
662              
663             __DATA__