lib/CXGN/Location.pm

   1
   2 =head1 NAME
   3
   4 CXGN::Location - helper class for locations
   5
   6 =head1 SYNOPSYS
   7
   8  my $location = CXGN::Location->new( { bcs_schema => $schema } );
   9  $location->set_altitude(280);
  10  etc.
  11
  12 =head1 AUTHOR
  13
  14 Bryan Ellerbrock <bje24@cornell.edu>
  15
  16 =head1 METHODS
  17
  18 =cut
  19
  20 package CXGN::Location;
  21
  22 use Moose;
  23 use Data::Dumper;
  24 use Try::Tiny;
  25 use SGN::Model::Cvterm;
  26 use CXGN::BrAPI::v2::ExternalReferences;
  27
  28 has 'bcs_schema' => (
  29         isa => 'Bio::Chado::Schema',
  30         is => 'rw',
  31     required => 1,
  32 );
  33
  34 has 'location' => (
  35     isa => 'Bio::Chado::Schema::Result::NaturalDiversity::NdGeolocation',
  36     is => 'rw',
  37 );
  38
  39 has 'nd_geolocation_id' => (
  40         isa => 'Maybe[Int]',
  41         is => 'rw',
  42 );
  43
  44 has 'name' => (
  45     isa => 'Str',
  46         is => 'rw',
  47 );
  48
  49 has 'abbreviation' => (
  50     isa => 'Maybe[Str]',
  51         is => 'rw',
  52 );
  53
  54 has 'country_name' => (
  55     isa => 'Maybe[Str]',
  56         is => 'rw',
  57 );
  58
  59 has 'country_code' => (
  60     isa => 'Maybe[Str]',
  61         is => 'rw',
  62 );
  63
  64 has 'breeding_programs' => (
  65     isa => 'Maybe[Str]',
  66         is => 'rw',
  67 );
  68
  69 has 'location_type' => (
  70     isa => 'Maybe[Str]',
  71         is => 'rw',
  72 );
  73
  74 has 'latitude' => (
  75     isa => 'Maybe[Num]',
  76         is => 'rw',
  77 );
  78
  79 has 'longitude' => (
  80     isa => 'Maybe[Num]',
  81         is => 'rw',
  82 );
  83
  84 has 'altitude' => (
  85     isa => 'Maybe[Num]',
  86         is => 'rw',
  87 );
  88
  89 has 'noaa_station_id' => (
  90     isa => 'Maybe[Str]',
  91         is => 'rw',
  92 );
  93
  94 has 'external_references' => (
  95     isa => 'Maybe[ArrayRef[HashRef[Str]]]',
  96     is  => 'rw'
  97 );
  98
  99 sub BUILD {
 100     my $self = shift;
 101
 102     print STDERR "RUNNING BUILD FOR LOCATION.PM...\n";
 103     my $location;
 104     if ($self->nd_geolocation_id){
 105         $location = $self->bcs_schema->resultset("NaturalDiversity::NdGeolocation")->find( { nd_geolocation_id => $self->nd_geolocation_id });
 106         $self->location($location);
 107     }
 108     if (defined $location) {
 109         $self->location( $self->location || $location );
 110         $self->nd_geolocation_id( $self->nd_geolocation_id || $location->nd_geolocation_id );
 111         $self->name( $self->name || $location->description );
 112         $self->abbreviation( $self->abbreviation || $self->_get_ndgeolocationprop('abbreviation', 'geolocation_property'));
 113         $self->country_name( $self->country_name || $self->_get_ndgeolocationprop('country_name', 'geolocation_property'));
 114         $self->country_code( $self->country_code || $self->_get_ndgeolocationprop('country_code', 'geolocation_property'));
 115         $self->breeding_programs( $self->breeding_programs || $self->_get_ndgeolocationprop('breeding_program', 'project_property'));
 116         $self->location_type( $self->location_type || $self->_get_ndgeolocationprop('location_type', 'geolocation_property'));
 117         $self->latitude( $self->latitude || $location->latitude);
 118         $self->longitude( $self->longitude || $location->longitude);
 119         $self->altitude( $self->altitude || $location->altitude);
 120         $self->noaa_station_id( $self->noaa_station_id || $self->_get_ndgeolocationprop('noaa_station_id', 'geolocation_property'));
 121         $self->external_references($self->external_references);
 122     }
 123
 124     print STDERR "Breeding programs are: ".$self->breeding_programs()."\n";
 125
 126     return $self;
 127 }
 128
 129 sub store_location {
 130         my $self = shift;
 131     my $schema = $self->bcs_schema();
 132     my $error;
 133
 134     my $nd_geolocation_id = $self->nd_geolocation_id();
 135     my $name = _trim($self->name());
 136     my $abbreviation = $self->abbreviation();
 137     my $country_name = $self->country_name();
 138     my $country_code = $self->country_code();
 139     my $breeding_programs = $self->breeding_programs();
 140     my $location_type = $self->location_type();
 141     my $latitude = $self->latitude();
 142     my $longitude = $self->longitude();
 143     my $altitude = $self->altitude();
 144     my $noaa_station_id = $self->noaa_station_id();
 145     my $external_references = $self->external_references();
 146
 147     # Validate properties
 148
 149     if (!$nd_geolocation_id && !$name) {
 150         return { error => "Cannot add a new location with an undefined name. A location name is required" };
 151     }
 152     elsif (!$nd_geolocation_id && !$self->_is_valid_name($name)) { # can't add a new location with name that already exists
 153         return { error => "The location - $name - already exists. Please choose another name, or use the existing location" };
 154     }
 155
 156     if (!$nd_geolocation_id && $abbreviation && !$self->_is_valid_abbreviation($abbreviation)) {
 157        return { error => "Abbreviation $abbreviation already exists in the database. Please choose another abbreviation" };
 158     }
 159
 160     if ($country_name && $country_name =~ m/[0-9]/) {
 161        return { error => "Country name $country_name is not a valid ISO standard country name." };
 162     }
 163
 164     if ($country_code && (($country_code !~ m/^[^a-z]*$/) || (length($country_code) != 3 ))) {
 165        return { error => "Country code $country_code is not a valid ISO Alpha-3 code." };
 166     }
 167
 168     my @breeding_program_ids;
 169     foreach my $breeding_program (split ("&", $breeding_programs)) {
 170         $breeding_program = _trim($breeding_program);
 171         if ($breeding_program && !$self->_is_valid_program($breeding_program)) { # can't use a breeding program that doesn't exist
 172             return { error => "Breeding program $breeding_program doesn't exist in the database." };
 173         } else {
 174             push @breeding_program_ids, $self->bcs_schema->resultset("Project::Project")->search({ name => $breeding_program })->first->project_id();
 175         }
 176     }
 177     my $breeding_program_ids = join '&', @breeding_program_ids;
 178
 179     if ($location_type && !$self->_is_valid_type($location_type)) {
 180         return { error => "Location type $location_type must be must be one of the following: Town, Farm, Field, Greenhouse, Screenhouse, Lab, Storage, Other." };
 181     }
 182
 183     if ( ($latitude && $latitude !~ /^-?[0-9.]+$/) || ($latitude && $latitude < -90) || ($latitude && $latitude > 90)) {
 184             return { error => "Latitude (in degrees) must be a number between 90 and -90." };
 185     }
 186
 187     if ( ($longitude && $longitude !~ /^-?[0-9.]+$/) || ($longitude && $longitude < -180) || ($longitude && $longitude > 180)) {
 188             return { error => "Longitude (in degrees) must be a number between 180 and -180." };
 189     }
 190
 191     if ( ($altitude && $altitude !~ /^-?[0-9.]+$/) || ($altitude && $altitude < -418) || ($altitude && $altitude > 8848) ) {
 192         return { error => "Altitude (in meters) must be a number between -418 (Dead Sea) and 8,848 (Mt. Everest)." };
 193     }
 194
 195     # Add new location if no id supplied
 196     if (!$nd_geolocation_id) {
 197         print STDERR "Checks completed, adding new location $name\n";
 198         my $coderef = sub {
 199             my $new_row = $schema->resultset('NaturalDiversity::NdGeolocation')
 200               ->new({
 201                      description => $name,
 202                     });
 203
 204             if (length $longitude) { $new_row->longitude($longitude); }
 205             if (length $latitude) { $new_row->latitude($latitude); }
 206             if (length $altitude) { $new_row->altitude($altitude); }
 207             $new_row->insert();
 208
 209             #$self->ndgeolocation_id($new_row->ndgeolocation_id());
 210             $self->location($new_row);
 211
 212             if ($abbreviation){
 213                 $self->_store_ndgeolocationprop('abbreviation', 'geolocation_property', $abbreviation);
 214             }
 215             if ($country_name){
 216                 $self->_store_ndgeolocationprop('country_name', 'geolocation_property', $country_name);
 217             }
 218             if ($country_code){
 219                 $self->_store_ndgeolocationprop('country_code', 'geolocation_property', $country_code);
 220             }
 221             if ($breeding_programs){
 222                 $self->_store_breeding_programs($breeding_program_ids);
 223             }
 224             if ($location_type){
 225                 $self->_store_ndgeolocationprop('location_type', 'geolocation_property', $location_type);
 226             }
 227             if ($noaa_station_id){
 228                 $self->_store_ndgeolocationprop('noaa_station_id', 'geolocation_property', $noaa_station_id);
 229             }
 230
 231             # save external references if specified
 232             if ($external_references) {
 233                 my $references = CXGN::BrAPI::v2::ExternalReferences->new({
 234                     bcs_schema          => $schema,
 235                     external_references => $external_references,
 236                     table_name          => 'nd_geolocation',
 237                     table_id_key         => 'nd_geolocation_id',
 238                     id             => $self->location()->nd_geolocation_id()
 239                 });
 240
 241                 $references->store();
 242
 243                 if ($references->{'error'}) {
 244                     return { error => $references->{'error'} };
 245                 }
 246             }
 247         };
 248
 249         my $transaction_error;
 250
 251         try {
 252             $schema->txn_do($coderef);
 253         } catch {
 254             $transaction_error =  $_;
 255         };
 256
 257         if ($transaction_error) {
 258             print STDERR "Error creating location $name: $transaction_error\n";
 259             return { error => $transaction_error };
 260         } else {
 261             print STDERR "Location $name added successfully\n";
 262             return { success => "Location $name added successfully\n", nd_geolocation_id=>$self->location()->nd_geolocation_id() };
 263         }
 264     }
 265     # Edit existing location if id supplied
 266     elsif ($nd_geolocation_id) {
 267         print STDERR "Checks completed, editing existing location $name\n";
 268         try {
 269             my $row = $schema->resultset("NaturalDiversity::NdGeolocation")->find({ nd_geolocation_id => $nd_geolocation_id });
 270             $row->description($name);
 271             $row->latitude($latitude);
 272             $row->longitude($longitude);
 273             $row->altitude($altitude);
 274             $row->update();
 275             $self->_update_ndgeolocationprop('abbreviation', 'geolocation_property', $abbreviation);
 276             $self->_update_ndgeolocationprop('country_name', 'geolocation_property', $country_name);
 277             $self->_update_ndgeolocationprop('country_code', 'geolocation_property', $country_code);
 278             $self->_update_ndgeolocationprop('location_type', 'geolocation_property', $location_type);
 279             $self->_update_ndgeolocationprop('noaa_station_id', 'geolocation_property', $noaa_station_id);
 280             $self->_store_breeding_programs($breeding_program_ids);
 281         }
 282         catch {
 283             $error =  $_;
 284         };
 285
 286         if ($error) {
 287             print STDERR "Error editing location $name: $error\n";
 288             return { error => $error };
 289         } else {
 290             print STDERR "Location $name was successfully updated\n";
 291             return { success => "Location $name was successfully updated\n", nd_geolocation_id=>$self->location()->nd_geolocation_id() };
 292         }
 293     }
 294 }
 295
 296 sub delete_location {
 297     my $self = shift;
 298     my $row = $self->bcs_schema->resultset("NaturalDiversity::NdGeolocation")->find({ nd_geolocation_id=> $self->nd_geolocation_id() });
 299     my $name = $row->description();
 300     my @experiments = $row->nd_experiments;
 301     #print STDERR "Associated experiments: ".Dumper(@experiments)."\n";
 302
 303     if (@experiments) {
 304         my $error = "Location $name cannot be deleted because there are ".scalar @experiments." measurements associated with it from at least one trial.\n";
 305         print STDERR $error;
 306         return { error => $error };
 307     }
 308         else {
 309             $row->delete();
 310         my $location_type_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'project location', 'project_property')->cvterm_id();
 311         my $projectprop_rows = $self->bcs_schema->resultset("Project::Projectprop")->search({ value=> $self->nd_geolocation_id(), type_id=> $location_type_id });
 312         while (my $r = $projectprop_rows->next()){ # remove any links to deleted location in projectprop
 313             $r->delete();
 314         }
 315         return { success => "Location $name was successfully deleted.\n" };
 316         }
 317 }
 318
 319 sub _get_ndgeolocationprop {
 320     my $self = shift;
 321     my $type = shift;
 322     my $cv = shift;
 323
 324     my $ndgeolocationprop_type_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, $type, $cv)->cvterm_id();
 325     my $rs = $self->bcs_schema()->resultset("NaturalDiversity::NdGeolocationprop")->search({ nd_geolocation_id=> $self->nd_geolocation_id(), type_id => $ndgeolocationprop_type_id }, { order_by => {-asc => 'nd_geolocationprop_id'} });
 326
 327     my @results;
 328     while (my $r = $rs->next()){
 329         push @results, $r->value;
 330     }
 331     my $res = join '&', @results;
 332     return $res;
 333 }
 334
 335 sub _update_ndgeolocationprop {
 336     my $self = shift;
 337     my $type = shift;
 338     my $cv = shift;
 339     my $value = shift;
 340     my $existing_prop = $self->_get_ndgeolocationprop($type, $cv);
 341
 342     if ($value) {
 343         $self->_store_ndgeolocationprop($type, $cv, $value);
 344     } elsif ($existing_prop) {
 345         $self->_remove_ndgeolocationprop($type, $cv, $existing_prop);
 346     }
 347 }
 348
 349 sub _store_breeding_programs {
 350     my $self = shift;
 351     my $new_programs = shift;
 352     my @new_programs = split ("&", $new_programs);
 353     my $existing_programs = $self->_get_ndgeolocationprop('breeding_program', 'project_property');
 354     my @existing_programs = split ("&", $existing_programs);
 355
 356     foreach my $existing_program (@existing_programs) {
 357         # print STDERR "Removing existing program $existing_program\n";
 358         $existing_program = _trim($existing_program);
 359         $self->_remove_ndgeolocationprop('breeding_program', 'project_property', $existing_program)
 360     }
 361     foreach my $new_program (@new_programs) {
 362         # print STDERR "Storing new program $new_program\n";
 363         $new_program = _trim($new_program);
 364         $self->location->create_geolocationprops({ 'breeding_program' => $new_program}, {cv_name => 'project_property' });
 365     }
 366 }
 367
 368 sub _store_ndgeolocationprop {
 369     my $self = shift;
 370     my $type = shift;
 371     my $cv = shift;
 372     my $value = shift;
 373     #print STDERR " Storing value $value with type $type\n";
 374     my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, $type, $cv)->cvterm_id();
 375     my $row = $self->bcs_schema()->resultset("NaturalDiversity::NdGeolocationprop")->find( { type_id=>$type_id, nd_geolocation_id=> $self->nd_geolocation_id() } );
 376
 377     if (defined $row) {
 378         $row->value($value);
 379         $row->update();
 380     } else {
 381         my $stored_ndgeolocationprop = $self->location->create_geolocationprops({ $type => $value}, {cv_name => $cv });
 382     }
 383 }
 384
 385 sub _remove_ndgeolocationprop {
 386     my $self = shift;
 387     my $type = shift;
 388     my $cv = shift;
 389     my $value = shift;
 390     my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, $type, $cv)->cvterm_id();
 391     my $rs = $self->bcs_schema()->resultset("NaturalDiversity::NdGeolocationprop")->search( { type_id=>$type_id, nd_geolocation_id=> $self->nd_geolocation_id(), value=>$value } );
 392
 393     if ($rs->count() == 1) {
 394         $rs->first->delete();
 395         return 1;
 396     }
 397     elsif ($rs->count() == 0) {
 398         return 0;
 399     }
 400     else {
 401         print STDERR "Error removing ndgeolocationprop from location ".$self->ndgeolocation_id().". Please check this manually.\n";
 402         return 0;
 403     }
 404
 405 }
 406
 407 sub _is_valid_name {
 408     my $self = shift;
 409     my $name = shift;
 410     my $schema = $self->bcs_schema();
 411     my $existing_name_count = $schema->resultset('NaturalDiversity::NdGeolocation')->search( { description => $name } )->count();
 412     if ($existing_name_count > 0) {
 413         return 0;
 414     }
 415     else {
 416         return 1;
 417     }
 418 }
 419
 420 sub _is_valid_abbreviation {
 421     my $self = shift;
 422     my $abbreviation = shift;
 423     my $schema = $self->bcs_schema();
 424     my $existing_abbreviation_count = $schema->resultset('NaturalDiversity::NdGeolocationprop')->search( { value => $abbreviation } )->count();
 425     if ($existing_abbreviation_count > 0) {
 426         return 0;
 427     }
 428     else {
 429         return 1;
 430     }
 431 }
 432
 433 sub _is_valid_program {
 434     my $self = shift;
 435     my $program = shift;
 436     my $schema = $self->bcs_schema();
 437     my $existing_program_count = $schema->resultset('Project::Project')->search(
 438         {
 439             'type.name'=> 'breeding_program',
 440             'me.name' => $program
 441         },
 442         {
 443             join => {
 444                 'projectprops' =>
 445                 'type'
 446             }
 447         }
 448     )->count();
 449     if ($existing_program_count < 1) {
 450         return 0;
 451     }
 452     else {
 453         return 1;
 454     }
 455 }
 456
 457 sub _is_valid_type {
 458     my $self = shift;
 459     my $type = shift;
 460     my %valid_types = (
 461         Town => 1,
 462         Farm => 1,
 463         Field => 1,
 464         Greenhouse => 1,
 465         Screenhouse => 1,
 466         Lab => 1,
 467         Storage => 1,
 468         Other => 1
 469     );
 470     if (!$valid_types{$type}) {
 471         return 0;
 472     }
 473     else {
 474         return 1;
 475     }
 476 }
 477
 478 sub _trim { #trim whitespace from both ends of a string
 479     my $s = shift;
 480     $s =~ s/^\s+|\s+$//g;
 481     return $s;
 482 }
 483
 484 1;