First commit: Added geohash-tool and Hashing.pm
authorGabriel Pérez-Cerezo <gabriel@gpcf.eu>
Sun, 18 Oct 2015 16:19:52 +0000 (18:19 +0200)
committerGabriel Pérez-Cerezo <gabriel@gpcf.eu>
Sun, 18 Oct 2015 16:19:52 +0000 (18:19 +0200)
.gitignore [new file with mode: 0644]
Hashing.pm [new file with mode: 0644]
geohash-tool [new file with mode: 0644]

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..e4e5f6c
--- /dev/null
@@ -0,0 +1 @@
+*~
\ No newline at end of file
diff --git a/Hashing.pm b/Hashing.pm
new file mode 100644 (file)
index 0000000..2c08c70
--- /dev/null
@@ -0,0 +1,344 @@
+#!/usr/bin/perl -w
+#
+# $Id: Hashing.pm 257 2008-06-25 02:02:19Z dan $
+#
+
+package Geo::Hashing;
+
+use strict;
+use warnings;
+use Carp;
+use Digest::MD5 qw/md5_hex/;
+
+our $VERSION = '0.06';
+
+=head1 NAME
+
+Geo::Hashing - Perl library to calculate Geohashing points
+
+=head1 SYNOPSIS
+
+  use Geo::Hashing;
+  my $g = new Geo::Hashing(lat => 37, lon => -122, date => "2008-05-24");
+  printf "Today's location is at %.6f, %.6f.\n", $g->lat, $g->lon;
+
+=head1 DESCRIPTION
+
+This module allows calculating the locaiton of Geohashes as described 
+in http://wiki.xkcd.com/geohashing/Main_Page.
+
+=head1 METHODS
+
+=cut
+
+=head2 new
+
+Create a new Geo::Hashing object.  
+
+=cut
+
+sub new {
+  my $class = shift;
+  my %p = @_;
+
+  my $self = {_lat => 0, _lon => 0, _dlat => 0, _dlon => 0, _debug => 0};
+  bless $self, $class;
+
+  $self->{_date} = sprintf("%04d-%02d-%02d", (localtime)[5]+1900, (localtime)[4]+1, (localtime)[3]);
+
+  {
+    no strict 'subs';
+    foreach (qw/debug source lat lon date use_30w_rule djia/) {
+      if (exists $p{$_}) {
+        $self->_log("Setting $_ to $p{$_}");
+        $self->$_($p{$_});
+      }
+    }
+  }
+
+  unless ($p{source}) {
+    $self->source('peeron');
+  }
+
+  $self->_log("Using", $self->source, "as the DJIA source");
+
+  return $self;
+}
+
+=head2 lat
+
+Set or get the points latitude.  When settings, only the integer portion is
+considered.  Set to undef to just get the offset.
+
+=cut
+
+sub lat {
+  my $self = shift;
+  my $lat = shift;
+
+  if (defined $lat) {
+    if ($lat =~ /^-?\d+(?:\.\d+)?$/ and $lat > -180 and $lat < 180) {
+      $self->{_lat} = $lat ne "-0" ? int($lat) : "-0";
+      $self->_update();
+    } else {
+      croak "Invalid latitude ($lat)!";
+    }
+  }
+
+  return undef unless defined $self->{_dlat} and defined $self->{_dlon};
+
+  return $self->{_lat} eq "-0" || $self->{_lat} < 0 ? 
+                     $self->{_lat} - $self->{_dlat} : 
+                     $self->{_lat} + $self->{_dlat};
+}
+
+=head2 lon
+
+Set or get the points longitude.  When settings, only the integer portion is
+considered.  Set to undef to just get the offset.
+
+=cut
+
+sub lon {
+  my $self = shift;
+  my $lon = shift;
+
+  if (defined $lon) {
+    if ($lon =~ /^-?\d+(?:\.\d+)?$/ and $lon > -180 and $lon < 180) {
+      $self->{_lon} = $lon ne "-0" ? int($lon) : "-0";
+      $self->_update();
+    } else {
+      croak "Invalid longitude ($lon)!";
+    }
+  }
+
+  return undef unless defined $self->{_dlat} and defined $self->{_dlon};
+
+  return $self->{_lon} eq "-0" || $self->{_lon} < 0 ? 
+                     $self->{_lon} - $self->{_dlon} : 
+                     $self->{_lon} + $self->{_dlon};
+}
+
+=head2 date
+
+Set or get the date used for the calculation.  Note that this is the actual
+date of the meetup in question, even when the 30w rule is in effect.
+
+=cut
+
+sub date {
+  my $self = shift;
+  my $date = shift;
+
+  if (defined $date) {
+    if ($date =~ /^\d\d\d\d-\d\d-\d\d$/) {
+      $self->{_date} = $date;
+      $self->djia(undef);
+      $self->_update();
+    } else {
+      croak "Invalid date ($date)!";
+    }
+  }
+
+  return $self->{_date};
+}
+
+=head2 djia
+
+Set or get the Dow Jones Industrial Average used for the calculation.  If not
+set, it will be automatically retrieved depending on the value of
+$self->source.  If the data cannot be retrieved, undef will be returned.
+
+=cut
+
+sub djia {
+  my $self = shift;
+  my $djia = shift;
+
+  if ($djia) {
+    if ($djia =~ /^\d+(?:\.\d+)?$/) {
+      $self->{_djia} = $djia;
+    } else {
+      croak "Invalid DJIA ($djia)!";
+    }
+  } elsif ($self->source) {
+    my $date = $self->date;
+#    if ($self->use_30w_rule) {
+    if ($self->{_lat} > -30) {
+      require Time::Local;
+      my ($y, $m, $d) = split /-/, $self->date;
+      my $time = Time::Local::timelocal(0, 0, 0, $d, $m-1, $y);
+      ($d, $m, $y) = (localtime($time - 24*60*60))[3,4,5];
+      $m++; $y += 1900;
+      $date = sprintf("%04d-%02d-%02d", $y, $m, $d);
+    }
+    $self->_log("Requesting", $self->source, "->DJIA($date)");
+    $self->{_djia} = $self->_get_djia($date);
+  } else {
+    $self->_log("No source set, can't automatically get DJIA");
+    return undef;
+  }
+  $self->{_djia} =~ s/ *$//g;
+  return $self->{_djia};
+}
+
+=head2 source
+
+Set the source of the DJIA opening data.  Will load Geo::Hashing::Source::Name
+and call get_djia($date).  See Geo::Hashing::Source::Random for a sample.
+
+=cut
+
+sub source {
+  my $self = shift;
+  my $source = shift;
+
+  if (defined $source) {
+    $self->_log("Loading source Geo::Hashing::Source::\u$source");
+    eval " require Geo::Hashing::Source::\u$source";
+
+    if ($@) {
+      croak "Failed to load Geo::Hashing::Source::\u$source: $@";
+    }
+
+    $self->{_source} = $source;
+    $self->_update();
+  }
+
+  if ($self->{_source}) {
+    return "Geo::Hashing::Source::" . ucfirst $self->{_source};
+  } else {
+    return undef;
+  }
+}
+
+=head2 use_30w_rule
+
+Set or get the 30w flag.  Will be set automatically if lon is set and is
+greater than -30.
+
+=cut
+
+sub use_30w_rule {
+
+  my $self = shift;
+  my $w30 = shift;
+  if (defined $w30) {
+    $self->{_30w} = $w30 ? 1 : 0;
+    $self->_update();
+  } elsif (defined $self->lon) {
+    if ($self->lon > -30) {
+      if (not $self->date) {
+        $self->{_30w} = 1;
+      } else {
+        my ($y, $m, $d) = split /-/, $self->date;
+        if ($y > 2008) {
+          $self->{_30w} = 1;
+        } elsif ($y == 2008 and $m > 5) {
+          $self->{_30w} = 1;
+        } elsif ($y == 2008 and $m == 5 and $d >= 27) {
+          $self->{_30w} = 1;
+        } else {
+          $self->{_30w} = 1;
+        }
+      }
+    } else {
+      $self->{_30w} = 0;
+    }
+  }
+  return $self->{_30w};
+}
+
+=head2 debug
+
+Enable or disable diagnostic logging
+
+=cut
+
+sub debug {
+  my $self = shift;
+  my $debug = shift;
+
+  if (defined $debug) {
+    $self->{_debug} = $debug ? 1 : 0;
+    $self->_log("Debug", $self->{_debug} ? "enabled" : "disabled");
+  }
+
+  return $self->{_debug};
+}
+
+# private methods
+# _update - given all the information in the object, calculate the day's
+#           offsets
+sub _update {
+  my $self = shift;
+
+  my $djia = $self->djia;
+  unless (defined $djia) {
+    $self->_log("Failed to get DJIA");
+    $self->{_dlat} = $self->{_dlon} = undef;
+    return undef;
+  }
+
+  $self->_log("DJIA for", $self->date, "is $djia");
+
+  my $md5 = md5_hex($self->date . "-" . $djia);
+  $self->_log(" - md5(". $self->date ."-$djia)");
+  $self->_log(" - md5 = $md5");
+
+  my ($md5lat, $md5lon) = (substr($md5, 0, 16), substr($md5, 16, 16));
+  $self->_log(" -     = $md5lat, $md5lon");
+  ($self->{_dlat}, $self->{_dlon}) = (0, 0);
+
+  while (length $md5lat) {
+    $self->{_dlat} += hex substr($md5lat, -1, 1, "");
+    $self->{_dlon} += hex substr($md5lon, -1, 1, "");
+    $self->{_dlat} /= 16;
+    $self->{_dlon} /= 16;
+  }
+
+  $self->_log(" dlat, dlon => $self->{_dlat}, $self->{_dlon}");
+}
+
+# _log - print out a timestampped log entry
+sub _log {
+  my $self = shift;
+
+  return unless $self->debug;
+
+  print scalar localtime, " - @_\n";
+}
+
+# _get_djia - call get_djia on from the current source
+sub _get_djia {
+  my $self = shift;
+
+  $self->_log("getting DJIA from", $self->source);
+  return $self->source->get_djia(@_);
+}
+
+=head1 SEE ALSO
+
+Original comic: http://www.xkcd.com/426/
+
+Wiki: http://wiki.xkcd.com/geohashing/Main_Page
+
+IRC: irc://irc.xkcd.com/geohashing
+
+=head1 AUTHOR
+
+Dan Boger, E<lt>zigdon@gmail.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2008 by Dan Boger
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
+
+1;
+
diff --git a/geohash-tool b/geohash-tool
new file mode 100644 (file)
index 0000000..1439ecd
--- /dev/null
@@ -0,0 +1,196 @@
+#!/usr/bin/perl
+
+# Copyright (C) 2015 Gabriel Pérez-Cerezo
+
+# Permission is hereby granted, free of charge, to any person
+# obtaining a copy of this software and associated documentation files
+# (the "Software"), to deal in the Software without restriction,
+# including without limitation the rights to use, copy, modify, merge,
+# publish, distribute, sublicense, and/or sell copies of the Software,
+# and to permit persons to whom the Software is furnished to do so,
+# subject to the following conditions:
+
+# The above copyright notice and this permission notice shall be
+# included in all copies or substantial portions of the Software.
+
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+# BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+# ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+# SOFTWARE.
+
+=encoding utf8
+
+=head1 geohash.pl
+
+
+geohash.pl - Get the geohash's location and its distance to your home or workplace
+
+=head1 SYNOPSIS
+
+geohash.pl [B<-d> I<DATE>] [B<-l> I<LAT.LON>]
+
+=head1 DESCRIPTION
+
+This script calculates the geohash's location for your graticule for
+any (past) date. Then it queries Openstreetmap and prints the place
+name. Finally, it prints the distance between your home (or any other
+point you specify) and the geohash.
+
+=head1 CONFIGURATION
+
+geohash.pl is configured using a YAML file located at F<~/.geohashrc.>
+It should look like this:
+
+    ---
+    lat: 0
+    lon: 1
+    0.1:
+      - name: Work
+        lat: 0.23142
+        lon: 1.2414921
+      - name: Home
+        lat: 0.1424439
+        lon: 1.2413813
+    0.3:
+      - name: Office
+        lat: 0.1424439
+        lon: 3.2413813
+
+Where lat: 0 and lon: 1 indicate your default graticule (can be
+overriden with the B<-l> switch). The places indicated below 0.1 and
+0.3 are the places to which the distance will be computed when looking
+for the Geohash in the 0,1 and 0,3 graticule, respectively.
+
+=head1 AUTHOR
+
+Gabriel Pérez-Cerezo - L<http://gpcf.eu>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2015 by Gabriel Pérez-Cerezo
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+=cut
+use strict;
+use warnings;
+use Geo::Hashing;
+use Math::Trig;
+use POSIX qw(strftime);
+use diagnostics;
+use utf8;
+use YAML;
+use Getopt::Std;
+binmode(STDOUT, ":utf8");
+my $today;
+my $content;
+my $url;
+our %opts;
+### Read the configuration file:
+my $string;
+our $VERSION = 0.1;
+my $pi = 3.14159265358979;
+$Getopt::Std::STANDARD_HELP_VERSION = 1;
+my $default = "
+---
+lat: 0
+lon: 1
+0.1:
+  - name: Work
+    lat: 0.23142
+    lon: 1.2414921
+  - name: Home
+    lat: 0.1424439
+    lon: 1.2413813
+";
+sub HELP_MESSAGE {
+  print <<EOF;
+Usage: $0 [-d DATE] [-l LAT.LONG]\n
+DATE must have the following format: YYYY-MM-DD.
+DATE must be the current day or earlier.
+LAT and LONG are integers. They describe your graticule.
+Example:
+   Get the Geohash for 2014-03-12 for the 40,10 graticule:
+   $0 -d 2014-03-12 -l 40.10
+EOF
+}
+sub distance {
+  # gives a rough estimate of the distance to the geohash. Accuracy:
+  # +/- cos(angle between coordinates)*37/2pi. (about +/- 50 m for
+  # geohashing distances).
+  my ($lat1, $long1, $lat2, $long2) = @_;
+  my $a = deg_to_rad(90 - $lat1);
+  my $b = deg_to_rad(90 - $lat2);
+  my $C = deg_to_rad(abs($long1-$long2));
+  return acos(cos($a)*cos($b)+sin($a)*sin($b)*cos($C))*40040/(2*$pi);
+}
+
+sub read_conf {
+  local $/ = undef;
+  unless (open FILE, $ENV{"HOME"} . "/.geohashrc")
+    {
+      print "Couldn't open conf file: $!. Using default configuration: $default";
+      return $default
+    }
+  binmode(FILE, ":utf8");
+  $string = <FILE>;
+  close FILE;
+  return $string;
+}
+
+$string = read_conf();
+unless ($string =~ m/\n$/s) {
+  $string .= "\n";
+}
+my $data = Load $string;
+# parse CLI options
+getopts('d:l:', \%opts);
+# set date
+$today = $opts{d} if defined $opts{d};
+
+# set graticule
+if (defined $opts{l} and $opts{l} =~ m/^-?[0-9]{1,3}\.-?[0-9]{1,3}$/g) {
+  ($data->{lat}, $data->{lon}) = split /\./, $opts{l};
+}
+
+unless ($data->{lat} and $data->{lon}) {
+  die "Please create a configuration file in ~/.geohashrc. Like this: \n $default";
+}
+my $key = $data->{lat} . "." . $data->{lon};
+
+my @places = ();
+if (defined $data->{$key}) {
+  @places = @{$data->{$key}};
+}
+# Get the date
+unless ($today) {
+  $today = strftime "%F", localtime;
+}
+
+my $g = new Geo::Hashing(lat => $data->{lat}, lon => $data->{lon}, date => $today);
+
+sub deg_to_rad { ($_[0]/180) * $pi }
+printf "The Location for $today is at %.6f, %.6f.\n", $g->lat, $g->lon;
+
+use LWP::Simple;
+import LWP::Simple 'get';
+$url = sprintf "http://nominatim.openstreetmap.org/reverse?format=xml&lat=%.6f&lon=%.6f&zoom=18&addressdetails=1", $g->lat, $g->lon;
+unless (defined ($content = get($url))) {
+    die "could not get $url\n";
+  }
+$content =~ s/^.*<result[^>]*>(.*)$/$1/s;
+$content =~ s/<.*//s;
+printf "Location: $content\n";
+
+
+foreach (@places) {
+  printf "Distance from $_->{name}: %.3f km\n", distance($g->lat, $g->lon, $_->{lat}, $_->{lon});
+}
+
+