Geo-Postcode-0.17/0002755000175000017500000000000011513656045012061 5ustar domdomGeo-Postcode-0.17/Changes0000644000175000017500000000132511513656004013346 0ustar domdomRevision history for Perl extension Geo::Postcode. 0.17 Thu 13 Jan 2011 20:09:27 GMT - Improve definedness checks [RT: #16956] - Refactor tests a little - Change @nicely as per [RT #24382] 0.16 Wed 12 Jan 2011 - Fix for tests/Makefile.PL (mstevens) 0.13 20 October 04 - uses latitude and longitude rather than lat and long internally: 'long' can't be a column name in mysql. 0.12 2 September 04 - fixed CPAN installation where requirements not met: database file now built at proper time thanks to own make target. 0.11 2 September 04 - Database file now built during installation to ensure compatibility. 0.1 31 August 04 - First release. What can possibly go wrong? Geo-Postcode-0.17/README0000644000175000017500000000173611513525264012744 0ustar domdomGeo/Postcode/Valid =============================== Hello. This is a very simple module that tests the well-formedness of UK postcodes and incidentally splits them into useful parts. For US zipcodes, you need Geo::Postalcode. It has been developed for geographical systems that work with postcodes at variable resolution: in other words, for people like me who can only afford to buy the cheaper postcode data sets. It should also be of use to people who want to validate input, as it should be very quick and memory efficient and doesn't load the location data or associated libraries until you ask for it. any trouble, write to wross@cpan.org or post a bug at rt.cpan.org. will 27 August 2004 INSTALLATION To install this module type the following: perl Makefile.PL make make test make install COPYRIGHT AND LICENCE Copyright (C) 2004 william ross This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Geo-Postcode-0.17/META.yml0000644000175000017500000000104411513656045013327 0ustar domdom--- #YAML:1.0 name: Geo-Postcode version: 0.17 abstract: UK Postcode validation and location author: - william ross license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 requires: DBD::SQLite: 0 DBI: 0 Test::More: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.48 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Geo-Postcode-0.17/MANIFEST0000644000175000017500000000041211513413766013206 0ustar domdomChanges Makefile.PL MANIFEST README lib/Geo/Postcode.pm lib/Geo/Postcode/Location.pm t/01_test.t t/02_pod.t postcodedata/makesqlite.pl postcodedata/makemysql.pl postcodedata/postcodes.csv META.yml Module meta-data (added by MakeMaker) Geo-Postcode-0.17/t/0002755000175000017500000000000011513656045012324 5ustar domdomGeo-Postcode-0.17/t/01_test.t0000755000175000017500000000511711513653521013771 0ustar domdom#!/usr/bin/perl -w use strict; use warnings; use DBI; use Test::More; $|++; BEGIN { plan (tests => 38); use_ok('Geo::Postcode'); } my $postcode = Geo::Postcode->new('la233pa'); isa_ok($postcode, 'Geo::Postcode', 'construction ok:'); is( $postcode->valid, 'LA23 3PA', "validation"); is( $postcode->area, 'LA', "area"); is( $postcode->district, 'LA23', "district"); is( $postcode->sector, 'LA23 3', "sector"); is( $postcode->unit, 'LA23 3PA', "unit"); is( scalar($postcode), 'LA23 3PA', "stringwise"); is_deeply( $postcode->analyse, ['LA23 3PA', 'LA23 3', 'LA23', 'LA'], "segmentation"); is (Geo::Postcode->sector('LA23 3PA'), 'LA23 3', "procedural interface"); is (Geo::Postcode->valid_fragment('LA23 3'), 1, "valid fragment"); is (Geo::Postcode->valid_fragment('LA233'), 1, "valid fragment"); is (Geo::Postcode->valid_fragment('Q23'), undef, "invalid fragment"); my @valid_postcodes = ('N12 0PJ','N20 0AD'); foreach my $valid (@valid_postcodes) { is(Geo::Postcode->valid($valid), $valid, "Valid: $valid"); my $no_space = $valid; $no_space =~ s/\s+//g; is(Geo::Postcode->valid($no_space), $valid, "Valid: $valid"); } my @invalid_postcodes = ( '23 3PA', # Must start with character 'QA23 3PA', 'LZ23 3PA', 'EC1Z 8PQ', 'LA23 3KA', 'LA23 3PK', 'LAA23 3PA', ); foreach my $invalid (@invalid_postcodes) { is (Geo::Postcode->valid($invalid), undef, "bad format:'$invalid' properly rejected"); } isa_ok($postcode->location, 'Geo::Postcode::Location', 'location object'); is($postcode->gridn, 497700, 'grid north'); is($postcode->gride, 340800, 'grid east'); is($postcode->lat, 54.371, 'grid latitude'); is($postcode->long, -2.911, 'grid longitude'); is($postcode->gridref, 'SD408977', 'OS gridref'); is($postcode->distance_from('EC1Y 8PQ'), 369, 'distance_from with string and defaults'); my $other = Geo::Postcode->new('ec1y8pq'); is($postcode->distance_from($other,'miles'), 229, 'distance_from with object and units'); is($postcode->distance_between($other,'miles'), 229, 'aka distance_between'); is($postcode->bearing_to($other,'miles'), 211, 'bearing_to'); is($postcode->friendly_bearing_to($other,'miles'), 'SSE', 'friendly_bearing_to'); my $hmm = Geo::Postcode->new('la233pa', { distance_units => 'm', }); is($hmm->distance_from($other), 369069, 'units set at construction time'); my $hmmm = Geo::Postcode->new('la233pa', { location_class => 'My::Own', }); is($hmmm->location_class, 'My::Own', 'location class set at construction time'); $hmmm->location_class('Geo::Postcode::Location'); is($hmmm->gridref, 'SD408977', 'location class mutator'); Geo-Postcode-0.17/t/02_pod.t0000644000175000017500000000022211513413766013567 0ustar domdom#!/usr/bin/perl use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Geo-Postcode-0.17/Makefile.PL0000644000175000017500000000160511513413766014034 0ustar domdom#!/usr/bin/perl -w # -*- perl -*- use strict; use lib qw( ./lib ); use ExtUtils::MakeMaker; $|++; WriteMakefile( NAME => 'Geo::Postcode', VERSION_FROM => 'lib/Geo/Postcode.pm', PREREQ_PM => { 'DBD::SQLite' => 0, "DBI" => 0, "Test::More" => 0 }, ( $] >= 5.005 ? ( ABSTRACT_FROM => 'lib/Geo/Postcode.pm', AUTHOR => 'william ross ' ) : () ), clean => { FILES => './blib/lib/Geo/Postcode/postcodes.db' }, PL_FILES => { "postcodedata/makesqlite.pl" => "postcodedata/makesqlite"}, ); sub test { my $class = shift; my $makefragment = $class->SUPER::test(@_); $makefragment =~ s/^(test ::)/$1 locationdata/m; return $makefragment; } sub install { my $class = shift; my $makefragment = $class->SUPER::install(@_); $makefragment =~ s/^(install ::)/$1 locationdata/m; return $makefragment; } Geo-Postcode-0.17/lib/0002755000175000017500000000000011523246215012622 5ustar domdomGeo-Postcode-0.17/lib/Geo/0002755000175000017500000000000011513656045013341 5ustar domdomGeo-Postcode-0.17/lib/Geo/Postcode/0002755000175000017500000000000011523246215015114 5ustar domdomGeo-Postcode-0.17/lib/Geo/Postcode/Location.pm0000644000175000017500000002416311513655205017230 0ustar domdompackage Geo::Postcode::Location; use strict; use warnings; use vars qw($VERSION $AUTOLOAD $datafile $tablename $dbh $broadosgrid $fineosgrid $units $pi); use DBI; $VERSION = '0.12'; $tablename = "postcodes"; $units = "km"; $pi = 3.14159; $datafile = undef; $dbh = undef; =head1 NAME Geo::Postcode::Location - helper class for Geo::Postcode that handles grid reference lookups =head1 SYNOPSIS $Geo::Postcode::Location::datafile = '/usr/local/lib/postcodes.db'; my ($x, $y) = Geo::Postcode->coordinates('EC1R 8BB'); =head1 DESCRIPTION Geo::Postcode::Location holds the gridref-lookup functions of Geo::Postcode. It is separated here to minimise the footprint of the main module and to facilitate subclassing. It doesn't really have a useful direct interface, since it requires an object of Geo::Postcode (or a subclass) and is most easily reached through that object, but it does have a couple of configuration variables and there is method documentation here for anyone interested in subclassing it or changing the data source. =head1 GRIDREF DATA There are at least three ways to supply your own gridref data. =over =item * replace the data file If you can get your data into a SQLite file, all you have to do is set the either C or $ENV{POSTCODE_DATA} to the full path to your data file: $Geo::Postcode::Location::datafile = '/home/site/data/postcodes.db'; # or PerlSetEnv POSTCODE_DATA /home/site/data/postcodes.db I've included (in ./useful) an idiot script that I use to turn .csv data into a SQLite file suitable for use with this module. =item * replace the database handle The query that we use to retrieve location information is very simple, and should work with any DBI database handle. If your application already makes available a suitable database handle, or you would like to create one externally and make sure it is reused, it should just work: $Geo::Postcode::Location::dbh = $my_dbh; $Geo::Postcode::Location::tablename = 'postcodedata'; my ($x, $y) = Geo::Postcode->coordinates('EC1Y 8PQ'); If running under mod_perl, you probably don't want to share the handle like that. You can achieve the same thing with instance methods and avoid side-effects, but you have to make the calls at the right time: my $postcode = Geo::Postcode->new('EC1Y 8PQ'); $postcode->location->dbh( $my_dbh ); $postcode->location->tablename( 'postcodedata' ); my ($x, $y) = $postcode->coordinates; =item * override the lookup mechanism in subclass The data-retrieval process is divided up to make this as simple as possible: see the method descriptions below for details. You should be able to replace the data source by overriding C or redo the whole lookup by replacing C. $Geo::Postcode->location_class('My::Location'); package My::Location; use base qw(Geo::Postcode::Location); sub dbh { ... } =back =head1 METHODS =head2 new () Constructs and returns a location object. Must be supplied with a postcode object of the class dictated by C. =cut sub new { my ($class, $postcode) = @_; return unless $postcode && ref $postcode eq $class->postcode_class; my $self = bless { postcode => $postcode }, $class; return $self; } =head2 postcode_class () Returns the full name of the postcode class we should be expecting. =cut sub postcode_class { 'Geo::Postcode' } =head2 postcode () Returns the postcode object used to construct this object. =cut sub postcode { return shift->{postcode} } =head2 retrieve () Retrieves location information for this postcode. This method is called during construction, retrieves all the necessary information in one go, so all the rest have to do is look up internal values. =cut sub retrieve { my $self = shift; return if $self->{retrieved}; my $table = $self->tablename || 'postcodes'; my $sth = $self->dbh->prepare("SELECT * from $table where postcode = ?"); my $row; my $codes = $self->postcode->analyse; TRY: for (@$codes) { $sth->execute($_); last TRY if $row = $sth->fetchrow_hashref; } $self->{$_} = $row->{$_} for $self->cols; $self->{retrieved} = 1; $sth->finish; $self->dbh->disconnect if $self->disconnect_after_use; return; } =head2 disconnect_after_use () If this returns a true value, then dbh->disconnect will be called after location information is retrieved. =cut sub disconnect_after_use { 0 } =head2 dbh () Accepts, returns - and creates, if necessary - the DBI handle that will be used to retrieve location information. This is only separate to make it easy to override. =cut sub dbh { my $self = shift; return $self->{dbh} = $_[0] if @_; return $self->{dbh} = $dbh if defined $dbh; return $self->{dbh} if $self->{dbh}; my $file = $self->datafile; return unless $file && -e $file && -f $file; eval 'require DBI;'; return warn "$@" if $@; return $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$file","",""); } =head2 datafile ( path_to_file ) Accepts and returns the location of the SQLite file we expect to provide location data. If no file path is supplied, or found by checking C<$Geo::Postcode::Location::datafile> and C<$ENV{POSTCODE_DATA}>, then we will scan the path to locate the default data file that is installed with this module. =cut sub datafile { my $self = shift; return $self->{datafile} = $_[0] if @_; return $self->{datafile} = $datafile if $datafile; return $self->{datafile} = $ENV{POSTCODE_DATA} if $ENV{POSTCODE_DATA}; return $self->{datafile} = _find_file('postcodes.db'); } sub _find_file { my $file = shift; my @files = grep { -e $_ } map { "$_/Geo/Postcode/$file" } @INC; return $files[0]; } =head2 tablename () Sets and gets the name of the database table that should be expected to hold postcode data. =cut sub tablename { my $self = shift; return $self->{tablename} = $_[0] if @_; return $self->{tablename} ||= $tablename; } =head2 cols () Returns a list of the columns we should pull from the database row into the location object's internal hash (and also provide as instance methods). This isn't used in the SQL query (which just SELECTs *), so we don't mind if columns are missing. =cut sub cols { return qw(gridn gride latitude longitude town ward nhsarea) } =head2 AUTOLOAD () Turns the columns defined by C into lookup methods. You can't set values this way: the whole module is strictly read-only. =cut sub AUTOLOAD { my $self = shift; my $m = $AUTOLOAD; $m =~ s/.*://; return if $m eq 'DESTROY'; $m = 'latitude' if $m eq 'lat'; $m = 'longitude' if $m eq 'long'; $self->retrieve; my %cols = map {$_=>1} $self->cols; return unless $cols{$m}; return $self->{$m} || '00'; } =head2 gridref () Returns a proper concatenated grid reference for this postcode, in classic Ordnance Survey AA123456 form rather than the all-digits version we use internally. See http://www.ordnancesurvey.co.uk/oswebsite/freefun/nationalgrid/nghelp2.html or the more sober http://vancouver-webpages.com/peter/osgbfaq.txt for more about grid references. Unlike other grid methods here, this one will also strip redundant trailing zeros from the eastings and northings for the sake of readability. =cut $broadosgrid = [ ['S', 'T'], ['N', 'O'], ['H', 'J'], ]; $fineosgrid = [ ['V', 'W', 'X', 'Y', 'Z'], ['Q', 'R', 'S', 'T', 'U'], ['L', 'M', 'N', 'O', 'P'], ['F', 'G', 'H', 'J', 'K'], ['A', 'B', 'C', 'D', 'E'], ]; sub gridref { my $self = shift; return $self->{gridref} if $self->{gridref}; $self->retrieve; my $n = $self->gridn; my $e = $self->gride; my $broadn = int($n / 500000 ); my $broade = int($e / 500000 ); $n %= 500000; $e %= 500000; my $finen = int($n / 100000 ); my $finee = int($e / 100000 ); $n %= 100000; $e %= 100000; $n =~ s/(0+)$//; $e =~ s/(0+)$//; $n .= '0' x (length($e) - length($n)); $e .= '0' x (length($n) - length($e)); return $self->{gridref} = $broadosgrid->[$broadn][$broade] . $fineosgrid->[$finen][$finee] . $e . $n; } =head2 distance_from () We prefer to use grid references to calculate distances, since they're laid out nicely on a flat plane and don't require us to remember our A-levels. This method just returns a single distance value. You can specify the units of distance by setting C<$Geo::Postcode::Location::units> or passing in a second parameter. Either way it must be one of 'miles', 'km' or 'm'. The default is 'km'. =cut sub distance_from { my ($self, $postcode, $u) = @_; return unless $postcode; $self->retrieve; my $dx = $self->gride - $postcode->gride; my $dy = $self->gridn - $postcode->gridn; my $distance = sqrt($dx**2 + $dy**2); $u ||= $units; # longer coordinates mean greater precision (*10 per digit), which means # smaller units. we therefore have to multiply out by a factor based # on the length of the coordinates to get a kilometer distance. # the multiplier is adjusted to return other units if required. my $multiplier = 10**(3 - length($self->gride)); $multiplier *= 0.6214 if $u eq 'miles'; $multiplier *= 1000 if $u eq 'm'; return int($distance * $multiplier); } =head2 bearing_to () Returns the angle from grid north, in degrees clockwise, of the line from this postcode to the postcode object supplied. =cut sub bearing_to { my ($self, $postcode) = @_; my $dx = $self->gride - $postcode->gride; my $dy = $self->gridn - $postcode->gridn; my $r = atan2($dy,$dx); my $d = (90 + ($r/$pi * 180) + 360) % 360; return $d; } =head2 friendly_bearing_to () Returns a readable approximation of the bearing from here to there, in a form like 'NW' or 'SSE'. =cut sub friendly_bearing_to { my ($self, $postcode) = @_; my $bearing = $self->bearing_to( $postcode ); my @nicely = qw(N NNW NW WNW W WSW SW SSW S SSE SE ESE E ENE NE NNE N); my $i = int( ($bearing + 11.25)/22.5 ); return $nicely[$i]; } =head1 AUTHOR William Ross, wross@cpan.org =head1 COPYRIGHT Copyright 2004 William Ross, spanner ltd. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Geo-Postcode-0.17/lib/Geo/Postcode.pm0000644000175000017500000004301411513655632015460 0ustar domdompackage Geo::Postcode; use strict; use vars qw($VERSION); use overload '""' => '_as_string', 'eq' => '_as_string'; $VERSION = '0.17'; =head1 NAME Geo::Postcode - UK Postcode validation and location =head1 SYNOPSIS use Geo::Postcode; my $postcode = Geo::Postcode->new('SW1 1AA'); return unless $postcode->valid; my ($n, $e) = ($postcode->gridn, $postcode->gride); # is the same as my ($n, $e) = $postcode->coordinates; # and alternative to my @location = ($postcode->lat, $postcode->long); # or the impatient can skip the construction step: my ($n, $e) = Geo::Postcode->coordinates('SW1 1AA'); my $clean_postcode = Geo::Postcode->valid( $postcode ); my ($unit, $sector, $district, $area) = Geo::Postcode->analyse('SW1 1AA'); =head1 DESCRIPTION Geo::Postcode will accept full or partial UK postcodes, validate them against the official spec, separate them into their significant parts, translate them into map references or co-ordinates and calculate distances between them. It does not check whether the supplied postcode exists: only whether it is well-formed according to British Standard 7666, which you can find here: http://www.govtalk.gov.uk/gdsc/html/frames/PostCode.htm Geo::Postcode will also work with partial codes, ie areas, districts and sectors. They won't validate, but you can test them for legitimacy with a call to C, and you can still turn them into grid references. To work with US zipcodes, you need Geo::Postalcode instead. =head1 GRID REFERENCES AND DATA FILES Any postcode, whether fully or partly specified, can be turned into a grid reference. The Post Office calls it a centroid, and it marks the approximate centre of the area covered by the code. Unfortunately, and inexplicably, this information is not public domain: unless you're prepared to work at a very crude level, you have to buy location data either from the Post Office or a data shop. This module comes with with a basic set of publicly-available coordinates that covers nearly all the postcode districts (ie it maps the first block of the postcode but not the second). This means that the coordinates we return and the distances we calculate are a bit crude, being based at best on the postcode area. See the POD for Geo::Delivery::Location for how to override the standard data set something more comprehensive. =head1 INTERFACE This is a mostly vanilla OOP module, but for quick and dirty work you can skip the object construction step and call a method directly with a postcode string. It will build the necessary object behind the scenes and return the result of the operation. my @coordinates = Geo::Postcode->coordinates('LA23 3PA'); my $postcode = Geo::Postcode->valid($input->param('postcode')); The object will not be available for any more requests, of course. =head1 INTERNALS The main Geo::Postcode object is very simple blessed hashref. The postcode information is stored as a four-element listref in $self->{postcode}. Location information is retrieved by the separate L, which by default uses SQLite but can easily be overridden to use the database or other source of your choice. The location machinery is not loaded until it's needed, so you can validate and parse postcodes very cheaply. =head1 CONSTRUCTION =head2 new ( postcode_string, location_class ) Constructs and returns the very simple postcode object. All other processing and loading is deferred. You can also pass in a couple of parameters up front, as a hashref after the postcode: my $postcode = Geo::Postcode->new('SW1 1AA', { location_class => 'My::Location::Data::Class', distance_units => 'miles', }) This list will probably grow. =cut sub new { my ($class, $postcode, $parameters) = @_; $class = ref $class || $class; my $self = { postcode_string => $postcode, postcode => [], location => undef, reformatted => undef, }; $self->{$_} = $parameters->{$_} for qw(location_class distance_units); return bless $self, $class; } =head2 postcode_string ( ) Always returns the (uppercased) postcode string with which the object was constructed. Cannot be set after construction. =cut sub postcode_string { return uc(shift->{postcode_string}); } =head2 fragments ( ) Breaks the postcode into its significant parts, eg: EC1R 8DH --> | EC | 1R | 8 | DH | then stores the parts for later reference and returns them as a listref. Most other methods in this class call C first to get their raw material. =cut sub fragments { my $self = shift; return $self->{postcode} if $self->{postcode} && @{ $self->{postcode} }; my $code = $self->postcode_string; my ($a, $d, $s, $u); if ($code =~ s/ *(\d)([A-Z]{2})$//) { $s = $1; $u = $2; } elsif ($code =~ s/ (\d)$//) { $s = $1; } if ($code =~ /^([A-Z]{1,2})(\d{1,2}[A-Z]{0,1})/) { $a = $1; $d = $2; } return $self->{postcode} = [$a, $d, $s, $u]; } =head1 LOCATION The first call to a location-related method of Geo::Postcode will cause the location class - normally L - to be loaded along with its data file, and a location object to be associated with this postcode object. We then pass all location-related queries on to the location object. The accuracy of the information returned by location methods depends on the resolution of the location data file: see the POD for Geo::Postcode::Location for how to supply your own dataset instead of using the crude set that comes with this module. =head2 location () Returns - and if necessary, creates - the location object associated with this postcode object. This operation is avoided until explicitly requested, so that simple postcode-validation can be as economical as possible. The location object does all the work of looking up map reference data, calculating distances and translating into other forms. =head2 location_class () Sets and/or returns the full name of the class that should be called to get a location object. Calling C after a location object has been constructed will cause that object to be destroyed, so that the next call to a location-dependent method constructs a new object of the newly-specified class. =head2 default_location_class () Returns the name of the location class we'll use if no other is specified. The default default is L, but if you're subclassing you will probably want to replace that with one of your own. =cut sub location_class { my $self = shift; my $class = shift; if (defined $class && $class ne $self->{location_class}) { $self->{location} = undef; return $self->{location_class} = $class; } return $self->{location_class} ||= $self->default_location_class; } sub default_location_class { 'Geo::Postcode::Location' } sub location { my $self = shift; return $self->{location} if $self->{location}; my $class = $self->location_class; eval "require $class"; die "Failed to load location class '$class': $@" if $@; return $self->{location} = $class->new($self); } =head2 gridn () gride () Return the OS grid reference coordinates of the centre of this postcode. =head2 gridref () Return the proper OS grid reference for this postcode, in classic AA123456 style. =cut sub gridn { return shift->location->gridn(@_); } sub gride { return shift->location->gride(@_); } sub gridref { return shift->location->gridref(@_); } =head2 lat () long () Return the latitude and longitude of the centre of this postcode. =cut sub lat { return shift->location->latitude(@_); } sub long { return shift->location->longitude(@_); } =head2 placename () ward () nhsarea () These return information from other fields that may or may not be present in your dataset. The default set supplied with this module doesn't have these extra fields but a set derived from the PAF normally will. =cut sub placename { return shift->location->placename(@_); } sub ward { return shift->location->ward(@_); } sub nhsarea { return shift->location->nhsarea(@_); } =head2 coordinates () Return the grid reference x, y coordinates of this postcode as two separate values. The grid reference we use here are completely numerical: the usual OS prefix is omitted and an absolute coordinate value returned unless you get a stringy version from C. =cut sub coordinates { my $self = shift; return ($self->gridn, $self->gride); } =head2 distance_from ( postcode object or string, unit ) Accepts a postcode object or string, and returns the distance from here to there. As usual, you can call this method directly (ie without first constructing an object), or with any combination of postcode strings and objects: my $distance = Geo::Postcode->distance_from('LA23 3PA', 'EC1Y 8PQ'); my $distance = Geo::Postcode->distance_from($postcode, 'EC1Y 8PQ'); my $distance = Geo::Postcode->distance_from('EC1Y 8PQ', $postcode); Will do what you would expect, and the last two should be exactly the same. C is provided as a synonym of C to make that read more sensibly: my $distance = Geo::Postcode->distance_between('LA23 3PA', 'EC1Y 8PQ'); In any of these cases you can supply an additional parameter dictating the units of distance: the options are currently 'miles', 'm' or 'km' (the default). my $distance = Geo::Postcode->distance_between('LA23 3PA', 'EC1Y 8PQ', 'miles'); The same thing can be accomplished by supplying a 'distance_units' parameter at construction time or, if you don't mind acting global, by setting C<$Geo::Postcode::Location::units>. =cut sub distance_from { my $self = shift; $self = $self->new(shift) unless ref $self; my $other = shift; my $units = shift || $self->{distance_units}; $other = ref($other) ? $other : $self->new($other); return $self->location->distance_from( $other, $units ); } sub distance_between { return shift->distance_from(@_); } =head2 bearing_to ( postcode objects or strings) Accepts a list of postcode objects and/or strings, and returns a corresponding list of the bearings from here to there, as degrees clockwise from grid North. =cut sub bearing_to { my $self = shift; $self = $self->new(@_) unless ref $self; return $self->location->bearing_to( ref($_[0]) ? $_[0] : $self->new($_[0]) ) unless wantarray; return map { $self->location->bearing_to( ref($_) ? $_ : $self->new($_) ) } @_; } =head2 friendly_bearing_to ( postcode objects or strings) Accepts a list of postcode objects and/or strings, and returns a corresponding list of rough directions from here to there. 'NW', 'ESE', that sort of thing. print "That's " . $postcode1->distance_to($postcode2) . " km " . $postcode1->friendly_bearing_to($postcode2) . " of here."; =cut sub friendly_bearing_to { my $self = shift; $self = $self->new(@_) unless ref $self; return $self->location->friendly_bearing_to( ref($_[0]) ? $_[0] : $self->new($_[0]) ) unless wantarray; return map { $self->location->friendly_bearing_to( ref($_) ? $_ : $self->new($_) ) } @_; } =head1 VALIDATION Postcodes are checked against BS7666, which specifies the various kinds of sequences allowed and the characters which may appear in each position. =head2 valid () If the postcode is well-formed and complete, this method returns true (in the useful form of the postcode itself, properly formatted). Otherwise, returns false. =cut sub valid { my $self = shift; $self = $self->new(@_) unless ref $self; return $self if $self->_special_case; my ($a, $d, $s, $u) = @{ $self->fragments }; return unless $a && defined $d && defined $s && $u; return if length($a) > 2; return if $a =~ /[\W\d]/; return if $a =~ /^[QVX]/; return if $a =~ /^.[IJZ]/; return if length($a) == 1 && $d =~ /[^\dABCDEFGHJKSTUW]$/; return if length($a) == 2 && $d =~ /[^\dABEHMNPRVWXY]$/; return if length($s) > 1; return if $s =~ /\D/; return if length($u) != 2; return if $u =~ /[^A-Z]/; return if $u =~ /[CIKMOV]/; return $self->_as_string; } =head2 valid_fragment () A looser check that doesn't mind incomplete postcodes. It will test that area, district or sector codes follow the rules for valid characters in that part of the postcode, and return true unless it finds anything that's not allowed. =cut sub valid_fragment { my $self = shift; $self = $self->new(@_) unless ref $self; return 1 if $self->_special_case; my ($a, $d, $s, $u) = @{ $self->fragments }; return unless $a; return if length($a) > 2; return if $a =~ /[\W\d]/; return if $a =~ /^[QVX]/; return if $a =~ /^.[IJZ]/; return 1 unless defined $d || defined $s || $u; return if length($a) == 1 && $d !~ /\d[\dABCDEFGHJKSTUW]?/; return if length($a) == 2 && $d !~ /\d[\dABEHMNPRVWXY]?/; return 1 unless defined $s || $u; return if length($s) > 1; return if $s =~ /\D/; return 1 unless $u; return if length($u) != 2; return if $u =~ /[^A-Z]/; return if $u =~ /[CIKMOV]/; return 1; } =head1 SEGMENTATION These methods provide the various sector, area and district codes that can be derived from a full postcode, each of which identifies a larger area that encloses the postcode area. =head1 analyse () Returns a list of all the codes present in this postcode, in descending order of specificity. So: Geo::Postcode->analyse('EC1Y8PQ'); will return: ('EC1Y 8PQ', 'EC1Y 8', 'EC1Y', 'EC') which is useful mostly for dealing with situations where you don't know what resolution will be available and need to try alternatives. We do this when location-finding, so as to be able to work with data of unpredictable or variable specificity (ie we are cheap and only buy very rough data sets, but people enter exact postcodes). =cut sub analyse { my $self = shift; $self = $self->new(@_) unless ref $self; return [ $self->unit, $self->sector, $self->district, $self->area, ]; } sub analyze { return shift->analyse(@_); } =head1 area () Returns the area code part of this postcode. This is the broadest area of all and is identified by the first one or two letters of the code: 'E' or 'EC' or 'LA' or whatever. =cut sub area { my $self = shift; $self = $self->new(@_) unless ref $self; return $self->fragments->[0]; } =head1 district () Returns the district code part of this postcode. This is also called the 'outward' part, by the post office: it consists of the first two or three characters and identifies the delivery office for this address. It will look like 'LA23' or 'EC1Y'. =cut sub district { my $self = shift; $self = $self->new(@_) unless ref $self; my ($a, $d, $s, $u) = @{ $self->fragments }; return unless defined $a && defined $d; return "$a$d"; } =head1 sector () Returns the sector code part of this postcode. This is getting more local: it includes the first part of the code and the first digit of the second part, and is apparent used by the delivery office to sort the package. It will look something like 'EC1Y 8' or 'E1 7', and note that the space *is* meaningful. 'E1 7' and 'E17' are not the same thing. =cut sub sector { my $self = shift; $self = $self->new(@_) unless ref $self; my ($a, $d, $s, $u) = @{ $self->fragments }; return unless defined $a && defined $d && defined $s; return "$a$d $s"; } =head1 unit () Returns the whole postcode, properly formatted (ie in caps and with a space in the right place, regardless of how it came in). This is similar to what you get just by stringifying the postcode object, with the important difference that unit() will only work for a well-formed postcode: print Geo::Postcode->unit('LA233PA'); # prints LA23 3PA print Geo::Postcode->new('LA233PA'); # prints LA23 3PA print Geo::Postcode->unit('LA23333'); # prints nothing print Geo::Postcode->new('LA23333'); # prints LA23 Whereas normal stringification - which calls C<_as_string> will print all the valid parts of a postcode. =cut sub unit { my $self = shift; $self = $self->new(@_) unless ref $self; my ($a, $d, $s, $u) = @{ $self->fragments }; return unless defined $a && defined $d && defined $s; return "$a$d $s$u"; } sub _as_string { my $self = shift; return $self->{reformatted} if $self->{reformatted}; my ($a, $d, $s, $u) = @{ $self->fragments }; $a = "" if not defined $a; $d = "" if not defined $d; $s = "" if not defined $s; $u = "" if not defined $u; return $self->{reformatted} = "$a$d $s$u"; } =head1 special_cases () Returns a list of known valid but non-conformist postcodes. The only official one is 'G1R 0AA', the old girobank address, but you can override this method to extend the list. =cut sub special_cases { return ('G1R 0AA'); } sub _special_case { my $self = shift; my $pc = $self->_as_string; return 1 if $pc && grep { $pc eq $_ } $self->special_cases; } =head1 PLANS The next majorish version of this module will support (but not require) the interface offered by Geo::Postalcode, so that one can be dropped into the place of the other. Some methods will not be relevant, but I'll try and keep as close a match as I can. =head1 AUTHOR William Ross, wross@cpan.org Development of this library is kindly supported by Amnesty International UK, who are pleased to see it distributed for public use but should not be held responsible for any shortcomings (or inadvertent copyright violations :). =head1 COPYRIGHT Copyright 2004 William Ross, spanner ltd. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Geo-Postcode-0.17/postcodedata/0002755000175000017500000000000011523246231014524 5ustar domdomGeo-Postcode-0.17/postcodedata/makemysql.pl0000755000175000017500000000233611513153552017073 0ustar domdom#!/usr/bin/perl -w # -*- perl -*- use strict; use DBI; $|++; my $database = 'amnesty'; my $csvdata = './postcodes.csv'; my $tablename = 'postcode_locations'; my $user = 'amnesty'; my $password = 'sus1e'; open( INPUT, $csvdata) || die("can\'t open file $csvdata: $!"); print "found postcode data ok\n"; my $dbh = DBI->connect("dbi:mysql:database=$database",$user,$password); print "connected to database ok\n" if $dbh; my @cols = split(",",); chomp @cols; my $columns = join(", ", map { "$_ varchar(255)" } grep { $_ ne "postcode" } @cols); print "data columns:\n$columns\n"; my $maketable = "create table $tablename (postcode varchar(12) NOT NULL, $columns, primary key(postcode));"; print "creating table with\n$maketable\n"; $dbh->do($maketable); print "created $tablename table.\nInserting location data."; my $counter; my $insert = "INSERT INTO $tablename( " . join(",",@cols) . " ) values ( " . join(",", map { "?" } @cols) . ")"; my $sth = $dbh->prepare($insert); while () { chomp; my @data = split(/,/); $sth->execute( @data ); $counter++; print "."; } $sth->finish; $dbh->disconnect; print "\n\ndone.\n$counter points imported into sample data set.\n\n"; Geo-Postcode-0.17/postcodedata/makesqlite.pl0000755000175000017500000000243311513153552017225 0ustar domdom#!/usr/bin/perl -w # -*- perl -*- use strict; use DBI; $|++; my $datafile = './blib/lib/Geo/Postcode/postcodes.db'; my $csvdata = './postcodedata/postcodes.csv'; my $tablename = 'postcodes'; if (-e $datafile) { print "datafile present.\n"; } else { print "building default postcode data store\n"; open( INPUT, $csvdata) || die("can\'t open file $csvdata: $!"); print "sample data found\n"; my $dbh = DBI->connect("dbi:SQLite:dbname=$datafile","",""); print "SQLite connection successful\n" if $dbh; my @cols = split(",",); my $columns = join(", ", map { "$_ varchar(255)" } grep { $_ ne "postcode" } @cols); $dbh->do("create table $tablename (postcode varchar(12) primary key, $columns);"); print "data table created. Inserting rows." if $dbh; my $counter; my $insert = "INSERT INTO $tablename( " . join(",",@cols) . " ) values ( " . join(",", map { "?" } @cols) . ")"; my $sth = $dbh->prepare($insert); while () { chomp; my @data = split(/,/); $sth->execute( @data ); $counter++; print "." unless $counter % 40; } $sth->finish; $dbh->disconnect; print "\n\ndone.\n$counter points imported into sample data set.\n\n"; }