new feature from Geo::Hash::XS

lib/Geo/Hash.pm

@@ -4,6 +4,15 @@ use warnings;
 use strict;
 use Carp;
 
+use Exporter 'import';
+our @EXPORT_OK   = qw( ADJ_TOP ADJ_RIGHT ADJ_LEFT ADJ_BOTTOM );
+our %EXPORT_TAGS = (adjacent => \@EXPORT_OK);
+
+use constant ADJ_RIGHT  => 0;
+use constant ADJ_LEFT   => 1;
+use constant ADJ_TOP    => 2;
+use constant ADJ_BOTTOM => 3;
+
 =head1 NAME
 
 Geo::Hash - Encode / decode geohash.org locations.
@@ -174,6 +183,117 @@ sub decode {
     return map { _mid( \@int, $_ ) } 0 .. 1;
 }
 
+=head2 C<< adjacent >>
+
+Returns the adjacent geohash. C<$where> denotes the direction, so if you
+want the block to the right of C<$hash>, you say:
+
+    use Geo::Hash qw(ADJ_RIGHT);
+
+    my $adjacent = $gh->adjacent( $hash, ADJ_RIGHT );
+
+=cut
+
+my @NEIGHBORS = (
+    [ "bc01fg45238967deuvhjyznpkmstqrwx", "p0r21436x8zb9dcf5h7kjnmqesgutwvy" ],
+    [ "238967debc01fg45kmstqrwxuvhjyznp", "14365h7k9dcfesgujnmqp0r2twvyx8zb" ],
+    [ "p0r21436x8zb9dcf5h7kjnmqesgutwvy", "bc01fg45238967deuvhjyznpkmstqrwx" ],
+    [ "14365h7k9dcfesgujnmqp0r2twvyx8zb", "238967debc01fg45kmstqrwxuvhjyznp" ]
+);
+
+my @BORDERS = (
+    [ "bcfguvyz", "prxz" ],
+    [ "0145hjnp", "028b" ],
+    [ "prxz", "bcfguvyz" ],
+    [ "028b", "0145hjnp" ]
+);
+
+sub adjacent {
+    my ( $self, $hash, $where ) = @_;
+    my $hash_len = length $hash;
+
+    croak "PANIC: hash too short!"
+        unless $hash_len >= 1;
+
+    my $base;
+    my $last_char;
+    my $type = $hash_len % 2;
+
+    if ( $hash_len == 1 ) {
+        $base      = '';
+        $last_char = $hash;
+    }
+    else {
+        ( $base, $last_char ) = $hash =~ /^(.+)(.)$/;
+        if ($BORDERS[$where][$type] =~ /$last_char/) {
+            my $tmp = $self->adjacent($base, $where);
+            substr($base, 0, length($tmp)) = $tmp;
+        }
+    }
+    return $base . $ENC[ index($NEIGHBORS[$where][$type], $last_char) ];
+}
+
+=head2 C<< neighbors >>
+
+Returns the list of neighbors (the blocks surrounding $hash)
+
+    my @list_of_geohashes = $gh->neighbors( $hash, $around, $offset )
+
+=cut
+
+sub neighbors {
+    my ( $self, $hash, $around, $offset ) = @_;
+    $around ||= 1;
+    $offset ||= 0;
+
+    my $last_hash = $hash;
+    my $i = 1;
+    while ( $offset-- > 0 ) {
+        my $top  = $self->adjacent( $last_hash, ADJ_TOP );
+        my $left = $self->adjacent( $top, ADJ_LEFT );
+        $last_hash = $left;
+        $i++;
+    }
+
+    my @list;
+    while ( $around-- > 0 ) {
+        my $max = 2 * $i - 1;
+        $last_hash = $self->adjacent( $last_hash, ADJ_TOP );
+        push @list, $last_hash;
+
+        for ( 0..( $max - 1 ) ) {
+            $last_hash = $self->adjacent( $last_hash, ADJ_RIGHT );
+            push @list, $last_hash;
+        }
+
+        for ( 0..$max ) {
+            $last_hash = $self->adjacent( $last_hash, ADJ_BOTTOM );
+            push @list, $last_hash;
+        }
+
+        for ( 0..$max ) {
+            $last_hash = $self->adjacent( $last_hash, ADJ_LEFT );
+            push @list, $last_hash;
+        }
+
+        for ( 0..$max ) {
+            $last_hash = $self->adjacent( $last_hash, ADJ_TOP );
+            push @list, $last_hash;
+        }
+        $i++;
+    }
+
+    return @list;
+}
+
+=head1 CONSTANTS
+
+=head2 ADJ_LEFT, ADJ_RIGHT, ADJ_TOP, ADJ_BOTTOM
+
+Used to specify the direction in C<adjacent()>
+
+=cut
+
 1;
 __END__
 

t/adjacent.t

@@ -0,0 +1,27 @@
+use strict;
+use warnings;
+use Test::More;
+use Geo::Hash qw(:adjacent);
+
+ok my $gh = Geo::Hash->new;
+isa_ok $gh, 'Geo::Hash';
+
+# Made these tests by using 
+# http://blog.masuidrive.jp/wp-content/uploads/2010/01/geohash.html
+is $gh->adjacent('xn76gg', ADJ_RIGHT), 'xn76u5'; # RIGHT
+is $gh->adjacent('xn76gg', ADJ_LEFT), 'xn76ge'; # LEFT
+is $gh->adjacent('xn76gg', ADJ_TOP), 'xn76gu'; # TOP
+is $gh->adjacent('xn76gg', ADJ_BOTTOM), 'xn76gf'; # BOTTOM
+
+is $gh->adjacent('xpst02vt', ADJ_RIGHT), 'xpst02vv'; # RIGHT
+is $gh->adjacent('xpst02vt', ADJ_LEFT), 'xpst02vm'; # LEFT
+is $gh->adjacent('xpst02vt', ADJ_TOP), 'xpst02vw'; # TOP
+is $gh->adjacent('xpst02vt', ADJ_BOTTOM), 'xpst02vs'; # BOTTOM
+
+# Check edge cases
+is $gh->adjacent('00', ADJ_BOTTOM), 'bp';
+is $gh->adjacent('00', ADJ_LEFT)  , 'pb';
+is $gh->adjacent('zz', ADJ_TOP)   , 'pb';
+is $gh->adjacent('zz', ADJ_RIGHT) , 'bp';
+
+done_testing;

t/neighbors.t

@@ -0,0 +1,39 @@
+use strict;
+use warnings;
+use Test::More;
+use Geo::Hash qw(:adjacent);
+
+my $gh = Geo::Hash->new;
+
+{
+    my @set = $gh->neighbors('xn76gg');
+    my @expect = qw/xn76gu xn76uh xn76u5 xn76u4 xn76gf xn76gd xn76ge xn76gs/;
+    ok eq_set \@set, \@expect or
+        diag "got '@set', but expected '@expect'";
+}
+
+{
+    my @set = $gh->neighbors('xpst02vt');
+    my @expect = qw/xpst02vw xpst02vy xpst02vv xpst02vu xpst02vs xpst02vk xpst02vm xpst02vq/;
+    ok eq_set \@set, \@expect or
+        diag "got '@set', but expected '@expect'";
+}
+
+{
+    my @set = $gh->neighbors('xn76gg', 2);
+    my @expect = qw/xn76gu xn76uh xn76u5 xn76u4 xn76gf xn76gd xn76ge xn76gs 
+                    xn76gv xn76gm xn76gk xn76g7 xn76um xn76u6 xn76g3 xn76g9 
+                    xn76uk xn76u7 xn76gc xn76uj xn76gt xn76g6 xn76u1 xn76u3/;
+    ok eq_set \@set, \@expect or
+        diag "got '@set', but expected '@expect'";
+}
+
+{
+    my @set = $gh->neighbors('xn76gg', 1, 1);
+    my @expect = qw/xn76gv xn76gm xn76gk xn76g7 xn76um xn76u6 xn76g3 xn76g9 
+                    xn76uk xn76u7 xn76gc xn76uj xn76gt xn76g6 xn76u1 xn76u3/;
+    ok eq_set \@set, \@expect or
+        diag "got '@set', but expected '@expect'";
+}
+
+done_testing;