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