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   71336 use strict;
  2         7  
  2         90  
6 2     2   17 use warnings;
  2         5  
  2         74  
7              
8 2     2   13 use Carp;
  2         6  
  2         145  
9              
10 2     2   13 use base 'Exporter';
  2         5  
  2         190  
11              
12 2     2   436 use Geo::UK::Postcode::Regex qw/ %REGEXES /;
  2         11  
  2         1610  
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   386017 my $class = shift;
25              
26 50         160 my %tags = map { $_ => 1 } @_;
  241         584  
27              
28             $MODE
29             = delete $tags{'-valid'} ? 'valid'
30             : delete $tags{'-lax'} ? 'lax'
31 50 100       307 : delete $tags{'-strict'} ? 'strict'
    100          
    100          
32             : $MODE;
33              
34             $PARTIAL #
35             = delete $tags{'-partial'} ? 1
36 50 100       191 : delete $tags{'-full'} ? 0
    100          
37             : $PARTIAL;
38             $ANCHORED
39             = delete $tags{'-unanchored'} ? 0
40 50 100       179 : delete $tags{'-anchored'} ? 1
    100          
41             : $ANCHORED;
42             $CAPTURES
43             = delete $tags{'-nocaptures'} ? 0
44 50 100       175 : delete $tags{'-captures'} ? 1
    100          
45             : $CAPTURES;
46              
47             $CASE_INSENSITIVE
48             = delete $tags{'-case-insensitive'} ? 1
49 50 100       188 : delete $tags{'-case-sensitive'} ? 0
    100          
50             : $CASE_INSENSITIVE;
51              
52 50         102 local $Exporter::ExportLevel = 1;
53 50         1718 $class->SUPER::import( grep { /^[^\-]/ } keys %tags );
  1         2373  
54             }
55              
56             sub postcode_re {
57              
58 49 100   49 1 705 croak "invalid \$MODE $MODE" if $MODE !~ m/^(?:strict|lax|valid)$/;
59              
60 48         112 my $key = $MODE;
61 48 100       199 $key .= '_partial' if $PARTIAL;
62 48 100       123 $key .= '_anchored' if $ANCHORED;
63 48 100       142 $key .= '_captures' if $CAPTURES;
64 48 100       150 $key .= '_case-insensitive' if $CASE_INSENSITIVE;
65              
66 48         296 return $REGEXES{$key};
67             }
68              
69             sub parse_pc {
70              
71 3600 50   3600 1 10029 croak "parse_pc only works with an anchored regex" unless $ANCHORED;
72              
73 3600 100       35782 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 4637600 croak "extract_pc only works with full postcodes" if $PARTIAL;
86              
87 3600 100       27839 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 10660225 my $pc = shift;
98              
99 7177 100       38962 croak "invalid \$MODE $MODE" if $MODE !~ m/^(?:strict|lax|valid)$/;
100              
101 7176         14728 my $key = $MODE;
102              
103 7176 100       19062 $key .= '_partial' if $PARTIAL;
104              
105 7176 100       16921 $key .= '_anchored' if $ANCHORED;
106              
107 7176 100       16931 $key .= '_case-insensitive' if $CASE_INSENSITIVE;
108              
109 7176 100       40158 return $pc =~ $REGEXES{$key} ? 1 : 0;
110             }
111              
112             1;
113              
114             __END__