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