File Coverage

blib/lib/Geo/UK/Postcode/Regex/Simple.pm
Criterion Covered Total %
statement 44 44 100.0
branch 58 60 96.6
condition n/a
subroutine 10 10 100.0
pod 4 4 100.0
total 116 118 98.3


line stmt bran cond sub pod time code
1             package Geo::UK::Postcode::Regex::Simple;
2              
3             our $VERSION = '0.015';
4              
5 2     2   88346 use strict;
  2         4  
  2         105  
6 2     2   14 use warnings;
  2         3  
  2         103  
7              
8 2     2   13 use Carp;
  2         2  
  2         212  
9              
10 2     2   14 use base 'Exporter';
  2         10  
  2         1368  
11              
12 2     2   1008 use Geo::UK::Postcode::Regex qw/ %REGEXES /;
  2         5  
  2         2922  
13              
14             our @EXPORT_OK = qw/ postcode_re extract_pc parse_pc validate_pc /;
15             our %EXPORT_TAGS = ( all => \@EXPORT_OK );
16              
17             our $MODE = 'strict'; # or 'valid' or 'lax'
18             our $PARTIAL = 0;
19             our $ANCHORED = 1;
20             our $CAPTURES = 1;
21             our $CASE_INSENSITIVE = 0;
22              
23             sub import {
24 50     50   140354 my $class = shift;
25              
26 50         201 my %tags = map { $_ => 1 } @_;
  241         670  
27              
28 50 100       449 $MODE
    100          
    100          
29             = delete $tags{'-valid'} ? 'valid'
30             : delete $tags{'-lax'} ? 'lax'
31             : delete $tags{'-strict'} ? 'strict'
32             : $MODE;
33              
34 50 100       255 $PARTIAL #
    100          
35             = delete $tags{'-partial'} ? 1
36             : delete $tags{'-full'} ? 0
37             : $PARTIAL;
38 50 100       231 $ANCHORED
    100          
39             = delete $tags{'-unanchored'} ? 0
40             : delete $tags{'-anchored'} ? 1
41             : $ANCHORED;
42 50 100       227 $CAPTURES
    100          
43             = delete $tags{'-nocaptures'} ? 0
44             : delete $tags{'-captures'} ? 1
45             : $CAPTURES;
46              
47 50 100       214 $CASE_INSENSITIVE
    100          
48             = delete $tags{'-case-insensitive'} ? 1
49             : delete $tags{'-case-sensitive'} ? 0
50             : $CASE_INSENSITIVE;
51              
52 50         125 local $Exporter::ExportLevel = 1;
53 50         2128 $class->SUPER::import( grep { /^[^\-]/ } keys %tags );
  1         4723  
54             }
55              
56             sub postcode_re {
57              
58 49 100   49 1 713 croak "invalid \$MODE $MODE" if $MODE !~ m/^(?:strict|lax|valid)$/;
59              
60 48         95 my $key = $MODE;
61 48 100       143 $key .= '_partial' if $PARTIAL;
62 48 100       142 $key .= '_anchored' if $ANCHORED;
63 48 100       142 $key .= '_captures' if $CAPTURES;
64 48 100       152 $key .= '_case-insensitive' if $CASE_INSENSITIVE;
65              
66 48         386 return $REGEXES{$key};
67             }
68              
69             sub parse_pc {
70              
71 3600 50   3600 1 11586 croak "parse_pc only works with an anchored regex" unless $ANCHORED;
72              
73 3600 100       55849 Geo::UK::Postcode::Regex->parse(
    100          
    100          
    100          
74             shift,
75             { partial => $PARTIAL ? 1 : 0,
76             strict => $MODE eq 'lax' ? 0 : 1,
77             valid => $MODE eq 'valid' ? 1 : 0,
78             'case-insensitive' => $CASE_INSENSITIVE ? 1 : 0,
79             }
80             );
81             }
82              
83             sub extract_pc {
84              
85 3600 50   3600 1 4246915 croak "extract_pc only works with full postcodes" if $PARTIAL;
86              
87 3600 100       43936 Geo::UK::Postcode::Regex->extract(
    100          
    100          
88             shift,
89             { strict => $MODE eq 'lax' ? 0 : 1,
90             valid => $MODE eq 'valid' ? 1 : 0,
91             'case-insensitive' => $CASE_INSENSITIVE ? 1 : 0,
92             }
93             );
94             }
95              
96             sub validate_pc {
97 7177     7177 1 9575051 my $pc = shift;
98              
99 7177 100       52458 croak "invalid \$MODE $MODE" if $MODE !~ m/^(?:strict|lax|valid)$/;
100              
101 7176         12472 my $key = $MODE;
102              
103 7176 100       21287 $key .= '_partial' if $PARTIAL;
104              
105 7176 100       20105 $key .= '_anchored' if $ANCHORED;
106              
107 7176 100       18010 $key .= '_case-insensitive' if $CASE_INSENSITIVE;
108              
109 7176 100       59982 return $pc =~ $REGEXES{$key} ? 1 : 0;
110             }
111              
112             1;
113              
114             __END__