summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Build.PL1
-rw-r--r--README1
-rw-r--r--lib/Travel/Status/DE/IRIS/Stations.pm25
3 files changed, 27 insertions, 0 deletions
diff --git a/Build.PL b/Build.PL
index 2c9237e..b0bcaa7 100644
--- a/Build.PL
+++ b/Build.PL
@@ -25,6 +25,7 @@ Module::Build->new(
'DateTime' => 0,
'DateTime::Format::Strptime' => 0,
'Encode' => 0,
+ 'Geo::Distance' => 0,
'Getopt::Long' => 0,
'List::Compare' => '0.29',
'List::MoreUtils' => 0,
diff --git a/README b/README
index a2e7ec8..a5e842a 100644
--- a/README
+++ b/README
@@ -11,6 +11,7 @@ Dependencies
* Class::Accessor
* DateTime
* DateTime::Format::Strptime
+* Geo::Distance
* List::Compare
* List::MoreUtils
* List::UtilsBy
diff --git a/lib/Travel/Status/DE/IRIS/Stations.pm b/lib/Travel/Status/DE/IRIS/Stations.pm
index c9863ac..54245ca 100644
--- a/lib/Travel/Status/DE/IRIS/Stations.pm
+++ b/lib/Travel/Status/DE/IRIS/Stations.pm
@@ -5,11 +5,16 @@ use warnings;
use 5.014;
use utf8;
+use Geo::Distance;
use List::Util qw(min);
use List::UtilsBy qw(uniq_by);
use List::MoreUtils qw(firstval pairwise);
use Text::LevenshteinXS qw(distance);
+# TODO Geo::Distance is kinda deprecated, it is recommended to use GIS::Distance
+# instead. However, since GIS::Distance is not packaged for Debian, I'll stick
+# with Geo::Distance for now (which works fine enough here)
+
# TODO switch to Text::Levenshtein::XS once AUR/Debian packages become available
our $VERSION = '1.05';
@@ -8487,6 +8492,26 @@ sub get_station {
return get_station_by_name($name);
}
+sub get_stations_by_location {
+ my ($lon, $lat, $num_matches) = @_;
+
+ $num_matches //= 10;
+
+ my $geo = Geo::Distance->new();
+
+ # we only use geolocations inside germany.
+ # For these, this fast preprocessing step will let through all
+ # coordinates inside a 60km radius (and a bunch which are farther out)
+ my @candidates = grep { $#{$_} >= 4 and abs($_->[3] - $lon) < 1 and abs($_->[4] - $lat) < 1 } @stations;
+ my @distances = map { $geo->distance('kilometer', $lon, $lat, $_->[3], $_->[4]) } @candidates;
+ my @station_map = pairwise { [ $a, $b ] } @candidates, @distances;
+
+ @station_map = sort { $a->[1] <=> $b->[1] } @station_map;
+ splice(@station_map, 10);
+
+ return @station_map;
+}
+
sub get_station_by_name {
my ($name) = @_;