3.12KiB; Perl | 2020-10-04 17:52:36+02 | Statements 41 | SLOC 97
1
package Geo::Coder::Abbreviations;
2
3
use warnings;
4
use strict;
5
use JSON;
6
use LWP::Simple;
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.03
15
16
=cut
17
18
our %abbreviations;
19
our $VERSION = '0.03';
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<HTTP::Cache::Transparent> 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
	my $proto = shift;
40
	my $class = ref($proto) || $proto;
41
42
	return unless(defined($class));
43
44
	unless(scalar keys(%abbreviations)) {
45
		if(eval { require HTTP::Cache::Transparent; }) {
46
			require File::Spec;	# That should be installed
47
48
			File::Spec->import();
49
			HTTP::Cache::Transparent->import();
50
51
			my $cachedir;
52
			if(my $e = $ENV{'CACHEDIR'}) {
53
				$cachedir = File::Spec->catfile($e, 'http-cache-transparent');
54
			} else {
55
				$cachedir = File::Spec->catfile(File::Spec->tmpdir(), 'cache', 'http-cache-transparent');
56
			}
57
58
			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
		my $data = get('https://raw.githubusercontent.com/mapbox/geocoder-abbreviations/master/tokens/en.json');
67
68
		die unless(defined($data));
69
70 1
		%abbreviations = map {
71
			my %rc = ();
72
			if(defined($_->{'type'}) && ($_->{'type'} eq 'way')) {
73
				foreach my $token(@{$_->{'tokens'}}) {
74
					$rc{uc($token)} = uc($_->{'canonical'});
75
				}
76
			}
77
			%rc;
78
		} @{JSON->new()->utf8()->decode($data)};
79
		# %abbreviations = map { (defined($_->{'type'}) && ($_->{'type'} eq 'way')) ? (uc($_->{'full'}) => uc($_->{'canonical'})) : () } @{JSON->new()->utf8()->decode($data)};
80
	}
81
82
	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
	my $self = shift;
101
102
	return $self->{'table'}->{uc(shift)};
103
}
104
105
=head1 SEE ALSO
106
107
L<https://github.com/mapbox/geocoder-abbreviations>
108
L<HTTP::Cache::Transparent>
109
110
=head1 AUTHOR
111
112
Nigel Horne, C<< <njh at bandsman.co.uk> >>
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<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Geo-Coder-Abbreviations>
129
130
=item * CPAN Ratings
131
132
L<http://cpanratings.perl.org/d/Geo-Coder-Abbreviations>
133
134
=item * Search CPAN
135
136
L<http://search.cpan.org/dist/Geo-Coder-Abbreviations/>
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