Open-ILS/src/perlmods/lib/OpenILS/Application/Geo.pm

   1 package OpenILS::Application::Geo;
   2
   3 use strict;
   4 use warnings;
   5
   6 use OpenSRF::AppSession;
   7 use OpenILS::Application;
   8 use base qw/OpenILS::Application/;
   9
  10 use OpenSRF::Utils::SettingsClient;
  11 use OpenILS::Utils::CStoreEditor qw/:funcs/;
  12 use OpenILS::Utils::Fieldmapper;
  13 use OpenSRF::Utils::Cache;
  14 use OpenILS::Application::AppUtils;
  15 my $U = "OpenILS::Application::AppUtils";
  16
  17 use OpenSRF::Utils::Logger qw/$logger/;
  18
  19 my $have_geocoder_free = eval {
  20     require Geo::Coder::Free;
  21     Geo::Coder::Free->import();
  22     1;
  23 };
  24 use Geo::Coder::OSM;
  25 use Geo::Coder::Google;
  26 use Geo::Coder::Bing;
  27
  28 use Math::Trig qw(great_circle_distance deg2rad);
  29 use Digest::SHA qw(sha256_base64);
  30
  31 my $cache;
  32 my $cache_timeout;
  33
  34 sub initialize {
  35     my $conf = OpenSRF::Utils::SettingsClient->new;
  36
  37     $cache_timeout = $conf->config_value(
  38             "apps", "open-ils.geo", "app_settings", "cache_timeout" ) || 300;
  39 }
  40 sub child_init {
  41     $cache = OpenSRF::Utils::Cache->new('global');
  42 }
  43
  44 sub calculate_distance {
  45     my ($self, $conn, $pointA, $pointB) = @_;
  46
  47     return new OpenILS::Event("BAD_PARAMS", "desc" => "Missing coordinates") unless $pointA;
  48     return new OpenILS::Event("BAD_PARAMS", "desc" => "Missing coordinates") unless $pointB;
  49     return new OpenILS::Event("BAD_PARAMS", "desc" => "Malformed coordinates") unless scalar(@{ $pointA }) == 2;
  50     return new OpenILS::Event("BAD_PARAMS", "desc" => "Malformed coordinates") unless scalar(@{ $pointB }) == 2;
  51
  52     sub NESW { deg2rad($_[1]), deg2rad(90 - $_[0]) } # longitude, latitude
  53     my @A = NESW( $pointA->[0], $pointA->[1] );
  54     my @B = NESW( $pointB->[0], $pointB->[1] );
  55     my $km = great_circle_distance(@A, @B, 6378);
  56
  57     return $km;
  58 }
  59 __PACKAGE__->register_method(
  60     method   => "calculate_distance",
  61     api_name => "open-ils.geo.calculate_distance",
  62     signature => {
  63         params => [
  64             {type => 'array', desc => 'An array containing latitude and longitude for point A'},
  65             {type => 'array', desc => 'An array containing latitude and longitude for point B'}
  66         ],
  67         return => { desc => '"Great Circle (as the crow flies)" distance between points A and B in kilometers'}
  68     }
  69 );
  70
  71 sub sort_orgs_by_distance_from_coordinate {
  72     my ($self, $conn, $pointA, $orgs) = @_;
  73
  74     return new OpenILS::Event("BAD_PARAMS", "desc" => "Missing coordinates") unless $pointA;
  75     return new OpenILS::Event("BAD_PARAMS", "desc" => "Malformed coordinates") unless scalar(@{ $pointA }) == 2;
  76     return new OpenILS::Event("BAD_PARAMS", "desc" => "Missing org list") unless $orgs;
  77     return new OpenILS::Event("BAD_PARAMS", "desc" => "Empty org list") unless scalar(@{ $orgs }) > 0;
  78
  79     my $e = new_editor(xact => 1);
  80
  81     my $fleshed_orgs = $e->search_actor_org_unit([
  82         {
  83             "id" => $orgs
  84         }, {
  85             "flesh" => 1,
  86             "flesh_fields" => {"aou" => ["billing_address"]}
  87         }
  88     ]) or return (undef, $e->die_event);
  89
  90     my @orgs_with_coordinates = grep {
  91            defined $_->billing_address
  92         && defined $_->billing_address->latitude
  93         && defined $_->billing_address->longitude } @$fleshed_orgs;
  94     my @orgs_without_coordinates = grep {
  95            !defined $_->billing_address
  96         || !defined $_->billing_address->latitude
  97         || !defined $_->billing_address->longitude } @$fleshed_orgs;
  98
  99     my @org_ids_with_distances = map {
 100             [ $_->id, calculate_distance($self, $conn, $pointA, [
 101                     $_->billing_address->latitude,
 102                     $_->billing_address->longitude
 103                 ]) ]
 104         } @orgs_with_coordinates;
 105
 106     my @sorted_orgs = sort { $a->[1] <=> $b->[1] } @org_ids_with_distances;
 107     push @sorted_orgs, map { [ $_->id, -1 ] } sort { $a->name cmp $b->name } @orgs_without_coordinates;
 108     my @sorted_org_ids = map { $_->[0] } @sorted_orgs;
 109
 110     return $self->api_name =~ /include_distances/ ? \@sorted_orgs : \@sorted_org_ids;
 111 }
 112 __PACKAGE__->register_method(
 113     method   => "sort_orgs_by_distance_from_coordinate",
 114     api_name => "open-ils.geo.sort_orgs_by_distance_from_coordinate",
 115     signature => {
 116         params => [
 117             {type => 'array', desc => 'An array containing latitude and longitude for the reference point'},
 118             {type => 'array', desc => 'An array of Context Organizational Unit IDs'}
 119         ],
 120         return => { desc => 'An array of Context Organizational Unit IDs sorted by geographic proximity to the reference point (closest first).  Units without coordinates are appended to the end of the list in alphabetical order by name relative to each other.'}
 121     }
 122 );
 123 __PACKAGE__->register_method(
 124     method   => "sort_orgs_by_distance_from_coordinate",
 125     api_name => "open-ils.geo.sort_orgs_by_distance_from_coordinate.include_distances",
 126     signature => {
 127         params => [
 128             {type => 'array', desc => 'An array containing latitude and longitude for the reference point'},
 129             {type => 'array', desc => 'An array of Context Organizational Unit IDs'}
 130         ],
 131         return => { desc => 'An array of Context Organizational Unit IDs and distances (each pair itself an array) sorted by geographic proximity to the reference point (closest first).  Units without coordinates are appended to the end of the list in alphabetical order by name relative to each other and given a distance of -1.'}
 132     }
 133 );
 134
 135
 136 sub retrieve_coordinates { # invoke 3rd party API for latitude/longitude lookup
 137     my ($self, $conn, $org, $address) = @_;
 138
 139     my $e = new_editor(xact => 1);
 140     # TODO: if we're not going to require authentication, we may want to consider
 141     #       implementing some options for limiting outgoing geo-coding API calls
 142     # return $e->die_event unless $e->checkauth;
 143
 144     $org = ref($org) ? $org->id : $org; # never trust the caller :-)
 145
 146     my $use_geo = $e->retrieve_config_global_flag('opac.use_geolocation');
 147     $use_geo = ($use_geo and $U->is_true($use_geo->enabled));
 148     return new OpenILS::Event("GEOCODING_NOT_ENABLED") unless ($U->is_true($use_geo));
 149
 150     return new OpenILS::Event("BAD_PARAMS", "desc" => "No org ID supplied") unless $org;
 151     my $service_id = $U->ou_ancestor_setting_value($org, 'opac.geographic_location_service_for_address');
 152     return new OpenILS::Event("GEOCODING_NOT_ALLOWED") unless ($U->is_true($service_id));
 153
 154     my $service = $e->retrieve_config_geolocation_service($service_id);
 155     return new OpenILS::Event("GEOCODING_NOT_ALLOWED") unless ($U->is_true($service));
 156
 157     $address =~ s/^\s+//;
 158     $address =~ s/\s+$//;
 159     return new OpenILS::Event("BAD_PARAMS", "desc" => "No address supplied") unless $address;
 160
 161     # Return cached coordinates if available. We're assuming that any
 162     # geolocation service will give roughly equivalent results, so we're
 163     # using a hash of the user-supplied address as the cache key, not
 164     # address + OU.
 165     my $cache_key = 'geo.address.' . sha256_base64($address);
 166     my $coords = OpenSRF::Utils::JSON->JSON2perl($cache->get_cache($cache_key));
 167     return $coords if $coords;
 168
 169     my $geo_coder;
 170     eval {
 171         if ($service->service_code eq 'Free') {
 172             if ($have_geocoder_free) {
 173                 $logger->debug("Using Geo::Coder::Free (service id $service_id)");
 174                 $geo_coder = Geo::Coder::Free->new();
 175             } else {
 176                 $logger->error("geosort: Geo::Coder::Free not installed but referenced.");
 177                 return OpenILS::Event->new('GEOCODING_LOCATION_NOT_FOUND');
 178             }
 179         } elsif ($service->service_code eq 'Google') {
 180             $logger->debug("Using Geo::Coder::Google (service id $service_id)");
 181             $geo_coder = Geo::Coder::Google->new(key => $service->api_key);
 182         } elsif ($service->service_code eq 'Bing') {
 183             $logger->debug("Using Geo::Coder::Bing (service id $service_id)");
 184             $geo_coder =  Geo::Coder::Bing->new(key => $service->api_key);
 185         } else {
 186             $logger->debug("Using Geo::Coder::OSM (service id $service_id)");
 187             $geo_coder = Geo::Coder::OSM->new();
 188         }
 189     };
 190     if ($@ || !$geo_coder) {
 191         $logger->error("geosort: problem creating Geo::Coder instance : $@");
 192         return OpenILS::Event->new('GEOCODING_LOCATION_NOT_FOUND');
 193     }
 194     my $location;
 195     eval {
 196         $location = $geo_coder->geocode(location => $address);
 197     };
 198     if ($@) {
 199         $logger->error("geosort: problem invoking location lookup : $@");
 200         return OpenILS::Event->new('GEOCODING_LOCATION_NOT_FOUND');
 201     }
 202
 203     my $latitude; my $longitude;
 204     return new OpenILS::Event("GEOCODING_LOCATION_NOT_FOUND") unless ($U->is_true($location));
 205     if ($service->service_code eq 'Free') {
 206        $latitude = $location->{'latitude'};
 207        $longitude = $location->{'longitude'};
 208     } elsif ($service->service_code eq 'Google') {
 209        $latitude = $location->{'geometry'}->{'location'}->{'lat'};
 210        $longitude = $location->{'geometry'}->{'location'}->{'lng'};
 211     } elsif ($service->service_code eq 'Bing') {
 212        $latitude = $location->{point}{coordinates}[0];
 213        $longitude = $location->{point}{coordinates}[1];
 214     } else {
 215        $latitude = $location->{lat};
 216        $longitude = $location->{lon};
 217     }
 218     $coords = { latitude => $latitude, longitude => $longitude };
 219     $cache->put_cache($cache_key, OpenSRF::Utils::JSON->perl2JSON($coords), $cache_timeout);
 220
 221     return $coords;
 222 }
 223 __PACKAGE__->register_method(
 224     method   => "retrieve_coordinates",
 225     api_name => "open-ils.geo.retrieve_coordinates",
 226     signature => {
 227         params => [
 228             {type => 'number', desc => 'Context Organizational Unit'},
 229             {type => 'string', desc => 'Address to look-up as a text string'}
 230         ],
 231         return => { desc => 'Hash/object containing latitude and longitude for the provided address.'}
 232     }
 233 );
 234
 235 1;