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