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