File Coverage

blib/lib/Geo/Coder/Abbreviations.pm
Criterion Covered Total %
statement 29 39 74.3
branch 7 14 50.0
condition 5 6 83.3
subroutine 5 6 83.3
pod 2 2 100.0
total 48 67 71.6


line stmt bran cond sub pod time code
1             package Geo::Coder::Abbreviations;
2              
3 3     3   382912 use warnings;
  3         27  
  3         106  
4 3     3   20 use strict;
  3         32  
  3         95  
5 3     3   2144 use JSON;
  3         31473  
  3         17  
6 3     3   1771 use LWP::Simple;
  3         202472  
  3         25  
7              
8             =head1 NAME
9              
10             Geo::Coder::Abbreviations - Quick and Dirty Interface to https://github.com/mapbox/geocoder-abbreviations
11              
12             =head1 VERSION
13              
14             Version 0.04
15              
16             =cut
17              
18             our %abbreviations;
19             our $VERSION = '0.04';
20              
21             =head1 SYNOPSIS
22              
23             Provides an interface to https://github.com/mapbox/geocoder-abbreviations.
24             One small function for now, I'll add others later.
25              
26             =head1 SUBROUTINES/METHODS
27              
28             =head2 new
29              
30             Creates a Geo::Coder::Abbreviations object.
31             It takes no arguments.
32             If you have L installed, it will load much
33             faster, otherwise it will download the database from the Internet
34             when the class is first instatiated.
35              
36             =cut
37              
38             sub new {
39 2     2 1 89 my $proto = shift;
40 2   66     14 my $class = ref($proto) || $proto;
41              
42 2 100       10 return unless(defined($class));
43              
44 1 50       5 unless(scalar keys(%abbreviations)) {
45 1 50       2 if(eval { require HTTP::Cache::Transparent; }) {
  1         176  
46 0         0 require File::Spec; # That should be installed
47              
48 0         0 File::Spec->import();
49 0         0 HTTP::Cache::Transparent->import();
50              
51 0         0 my $cachedir;
52 0 0       0 if(my $e = $ENV{'CACHEDIR'}) {
53 0         0 $cachedir = File::Spec->catfile($e, 'http-cache-transparent');
54             } else {
55 0         0 $cachedir = File::Spec->catfile(File::Spec->tmpdir(), 'cache', 'http-cache-transparent');
56             }
57              
58 0 0       0 HTTP::Cache::Transparent::init({
59             BasePath => $cachedir,
60             # Verbose => $opts{'v'} ? 1 : 0,
61             NoUpdate => 60 * 60 * 24,
62             MaxAge => 30 * 24
63             }) || die "$0: $cachedir: $!";
64             }
65              
66 1         9 my $data = get('https://raw.githubusercontent.com/mapbox/geocoder-abbreviations/master/tokens/en.json');
67              
68 1 50       605593 die unless(defined($data));
69              
70             %abbreviations = map {
71 343         323 my %rc = ();
72 343 100 100     617 if(defined($_->{'type'}) && ($_->{'type'} eq 'way')) {
73 62         61 foreach my $token(@{$_->{'tokens'}}) {
  62         86  
74 144         336 $rc{uc($token)} = uc($_->{'canonical'});
75             }
76             }
77 343         489 %rc;
78 1         4 } @{JSON->new()->utf8()->decode($data)};
  1         806  
79             # %abbreviations = map { (defined($_->{'type'}) && ($_->{'type'} eq 'way')) ? (uc($_->{'full'}) => uc($_->{'canonical'})) : () } @{JSON->new()->utf8()->decode($data)};
80             }
81              
82 1         158 return bless {
83             table => \%abbreviations
84             }, $class;
85             }
86              
87             =head2 abbreviate
88              
89             Abbreviate a place.
90              
91             use Geo::Coder::Abbreviations;
92              
93             my $abbr = Geo::Coder::Abbreviations->new();
94             print $abbr->abbreviate('Road'), "\n"; # prints 'RD'
95             print $abbr->abbreviate('RD'), "\n"; # prints 'RD'
96              
97             =cut
98              
99             sub abbreviate {
100 0     0 1   my $self = shift;
101              
102 0           return $self->{'table'}->{uc(shift)};
103             }
104              
105             =head1 SEE ALSO
106              
107             L
108             L
109              
110             =head1 AUTHOR
111              
112             Nigel Horne, C<< >>
113              
114             =head1 BUGS
115              
116             =head1 SUPPORT
117              
118             You can find documentation for this module with the perldoc command.
119              
120             perldoc Geo::Coder::Abbreviations
121              
122             You can also look for information at:
123              
124             =over 4
125              
126             =item * RT: CPAN's request tracker
127              
128             L
129              
130             =item * CPAN Ratings
131              
132             L
133              
134             =item * Search CPAN
135              
136             L
137              
138             =back
139              
140             =head1 ACKNOWLEDGEMENTS
141              
142             =head1 LICENSE AND COPYRIGHT
143              
144             Copyright 2020 Nigel Horne.
145              
146             This program is released under the following licence: GPL2
147              
148             =cut
149              
150             1; # End of Geo::Coder::Abbreviations