lib/CXGN/BreedersToolbox/Projects.pm

   1
   2 package CXGN::BreedersToolbox::Projects;
   3
   4 use Moose;
   5 use Data::Dumper;
   6 use SGN::Model::Cvterm;
   7
   8 has 'schema' => (
   9                  is       => 'rw',
  10                  isa      => 'DBIx::Class::Schema',
  11                 );
  12
  13
  14 sub trial_exists {
  15     my $self = shift;
  16     my $trial_id = shift;
  17
  18     my $rs = $self->schema->resultset('Project::Project')->search( { project_id => $trial_id });
  19
  20     if ($rs->count() == 0) {
  21         return 0;
  22     }
  23     return 1;
  24 }
  25
  26 sub get_breeding_programs {
  27     my $self = shift;
  28
  29
  30     my $breeding_program_cvterm_id = $self->get_breeding_program_cvterm_id();
  31
  32     my $rs = $self->schema->resultset('Project::Project')->search( { 'projectprops.type_id'=>$breeding_program_cvterm_id }, { join => 'projectprops' }  );
  33
  34     my @projects;
  35     while (my $row = $rs->next()) {
  36         push @projects, [ $row->project_id, $row->name, $row->description ];
  37     }
  38
  39     return \@projects;
  40 }
  41
  42 # deprecated. Use CXGN::Trial->get_breeding_program instead.
  43 sub get_breeding_programs_by_trial {
  44     my $self = shift;
  45     my $trial_id = shift;
  46
  47     my $breeding_program_cvterm_id = $self->get_breeding_program_cvterm_id();
  48
  49     my $trial_rs= $self->schema->resultset('Project::ProjectRelationship')->search( { 'subject_project_id' => $trial_id } );
  50
  51     my $trial_row = $trial_rs -> first();
  52     my $rs;
  53     my @projects;
  54
  55     if ($trial_row) {
  56         $rs = $self->schema->resultset('Project::Project')->search( { 'me.project_id' => $trial_row->object_project_id(), 'projectprops.type_id'=>$breeding_program_cvterm_id }, { join => 'projectprops' }  );
  57
  58         while (my $row = $rs->next()) {
  59             push @projects, [ $row->project_id, $row->name, $row->description ];
  60         }
  61     }
  62     return  \@projects;
  63 }
  64
  65
  66
  67 sub get_breeding_program_by_name {
  68   my $self = shift;
  69   my $program_name = shift;
  70   my $breeding_program_cvterm_id = $self->get_breeding_program_cvterm_id();
  71
  72   my $rs = $self->schema->resultset('Project::Project')->find( { 'name'=>$program_name, 'projectprops.type_id'=>$breeding_program_cvterm_id }, { join => 'projectprops' }  );
  73
  74   if (!$rs) {
  75     return;
  76   }
  77
  78   return $rs;
  79
  80 }
  81
  82 sub _get_all_trials_by_breeding_program {
  83     my $self = shift;
  84     my $breeding_project_id = shift;
  85     my $dbh = $self->schema->storage->dbh();
  86     my $breeding_program_cvterm_id = $self->get_breeding_program_cvterm_id();
  87
  88     my $trials = [];
  89     my $h;
  90     if ($breeding_project_id) {
  91         # need to convert to dbix class.... good luck!
  92         #my $q = "SELECT trial.project_id, trial.name, trial.description FROM project LEFT join project_relationship ON (project.project_id=object_project_id) LEFT JOIN project as trial ON (subject_project_id=trial.project_id) LEFT JOIN projectprop ON (trial.project_id=projectprop.project_id) WHERE (project.project_id=? AND (projectprop.type_id IS NULL OR projectprop.type_id != ?))";
  93         my $q = "SELECT trial.project_id, trial.name, trial.description, projectprop.type_id, projectprop.value FROM project LEFT join project_relationship ON (project.project_id=object_project_id) LEFT JOIN project as trial ON (subject_project_id=trial.project_id) LEFT JOIN projectprop ON (trial.project_id=projectprop.project_id) WHERE (project.project_id = ?)";
  94
  95         $h = $dbh->prepare($q);
  96         #$h->execute($breeding_project_id, $cross_cvterm_id);
  97         $h->execute($breeding_project_id);
  98
  99     }
 100     else {
 101         # get trials that are not associated with any project
 102         my $q = "SELECT project.project_id, project.name, project.description , projectprop.type_id, projectprop.value FROM project JOIN projectprop USING(project_id) LEFT JOIN project_relationship ON (subject_project_id=project.project_id) WHERE project_relationship_id IS NULL and projectprop.type_id != ?";
 103         $h = $dbh->prepare($q);
 104         $h->execute($breeding_program_cvterm_id);
 105     }
 106
 107     return $h;
 108 }
 109
 110 sub get_trials_by_breeding_program {
 111     my $self = shift;
 112     my $breeding_project_id = shift;
 113     my $field_trials;
 114     my $cross_trials;
 115     my $genotyping_trials;
 116     my $h = $self->_get_all_trials_by_breeding_program($breeding_project_id);
 117     my $cross_cvterm_id = $self->get_cross_cvterm_id();
 118     my $project_year_cvterm_id = $self->get_project_year_cvterm_id();
 119
 120     my %projects_that_are_crosses;
 121     my %project_year;
 122     my %project_name;
 123     my %project_description;
 124     my %projects_that_are_genotyping_trials;
 125
 126     while (my ($id, $name, $desc, $prop, $propvalue) = $h->fetchrow_array()) {
 127         #print STDERR "PROP: $prop, $propvalue \n";
 128         #push @$trials, [ $id, $name, $desc ];
 129       if ($name) {
 130         $project_name{$id} = $name;
 131       }
 132       if ($desc) {
 133         $project_description{$id} = $desc;
 134       }
 135       if ($prop) {
 136         if ($prop == $cross_cvterm_id) {
 137           $projects_that_are_crosses{$id} = 1;
 138           $project_year{$id} = '';
 139           #print STDERR Dumper "Cross Trial: ".$name;
 140         }
 141         if ($prop == $project_year_cvterm_id) {
 142           $project_year{$id} = $propvalue;
 143         }
 144         if ($propvalue) {
 145         if ($propvalue eq "genotyping_plate") {
 146             #print STDERR "$id IS GENOTYPING TRIAL\n";
 147             $projects_that_are_genotyping_trials{$id} =1;
 148                 #print STDERR Dumper "Genotyping Trial: ".$name;
 149         }
 150         }
 151       }
 152
 153     }
 154
 155     my @sorted_by_year_keys = sort { $project_year{$a} cmp $project_year{$b} } keys(%project_year);
 156
 157     foreach my $id_key (@sorted_by_year_keys) {
 158                 if (!$projects_that_are_crosses{$id_key} && !$projects_that_are_genotyping_trials{$id_key}) {
 159                         #print STDERR "$id_key RETAINED.\n";
 160                         push @$field_trials, [ $id_key, $project_name{$id_key}, $project_description{$id_key}];
 161                 } elsif ($projects_that_are_crosses{$id_key} == 1) {
 162                         push @$cross_trials, [ $id_key, $project_name{$id_key}, $project_description{$id_key}];
 163                 } elsif ($projects_that_are_genotyping_trials{$id_key} == 1) {
 164                         push @$genotyping_trials, [ $id_key, $project_name{$id_key}, $project_description{$id_key}];
 165                 }
 166     }
 167
 168     return ($field_trials, $cross_trials, $genotyping_trials);
 169 }
 170
 171 sub get_genotyping_trials_by_breeding_program {
 172     my $self = shift;
 173     my $breeding_project_id = shift;
 174     my $trials;
 175     my $h = $self->_get_all_trials_by_breeding_program($breeding_project_id);
 176     my $cross_cvterm_id = $self->get_cross_cvterm_id();
 177     my $project_year_cvterm_id = $self->get_project_year_cvterm_id();
 178
 179     my %projects_that_are_crosses;
 180     my %projects_that_are_genotyping_trials;
 181     my %project_year;
 182     my %project_name;
 183     my %project_description;
 184
 185     while (my ($id, $name, $desc, $prop, $propvalue) = $h->fetchrow_array()) {
 186         if ($name) {
 187             $project_name{$id} = $name;
 188         }
 189         if ($desc) {
 190             $project_description{$id} = $desc;
 191         }
 192         if ($prop) {
 193             if ($prop == $cross_cvterm_id) {
 194                 $projects_that_are_crosses{$id} = 1;
 195             }
 196             if ($prop == $project_year_cvterm_id) {
 197                 $project_year{$id} = $propvalue;
 198             }
 199
 200             if ($propvalue eq "genotyping_plate") {
 201                 $projects_that_are_genotyping_trials{$id} = 1;
 202             }
 203         }
 204
 205     }
 206
 207     my @sorted_by_year_keys = sort { $project_year{$a} cmp $project_year{$b} } keys(%project_year);
 208
 209     foreach my $id_key (@sorted_by_year_keys) {
 210       if (!$projects_that_are_crosses{$id_key}) {
 211         if ($projects_that_are_genotyping_trials{$id_key}) {
 212           push @$trials, [ $id_key, $project_name{$id_key}, $project_description{$id_key}];
 213         }
 214       }
 215     }
 216
 217     return $trials;
 218
 219 }
 220
 221
 222 sub get_locations_by_breeding_program {
 223     my $self = shift;
 224     my $breeding_program_id = shift;
 225
 226     my $h;
 227
 228     my $type_id = $self->schema->resultset('Cv::Cvterm')->search( { 'name'=>'plot' })->first->cvterm_id;
 229
 230     my $project_location_type_id = $self ->schema->resultset('Cv::Cvterm')->search( { 'name' => 'project location' })->first->cvterm_id();
 231
 232     if ($breeding_program_id) {
 233         #my $q = "SELECT distinct(nd_geolocation_id), nd_geolocation.description, count(distinct(stock.stock_id)) FROM project JOIN project_relationship on (project_id=object_project_id) JOIN project as trial ON (subject_project_id=trial.project_id) JOIN nd_experiment_project ON (trial.project_id=nd_experiment_project.project_id) JOIN nd_experiment USING (nd_experiment_id) JOIN nd_experiment_stock ON (nd_experiment.nd_experiment_id=nd_experiment_stock.nd_experiment_id) JOIN stock ON (nd_experiment_stock.stock_id=stock.stock_id) JOIN nd_geolocation USING (nd_geolocation_id) WHERE project.project_id=? and stock.type_id=? GROUP BY nd_geolocation.nd_geolocation_id, nd_experiment.nd_geolocation_id, nd_geolocation.description";
 234
 235         my $q = "SELECT distinct(nd_geolocation_id), nd_geolocation.description, count(distinct(trial.project_id)) FROM project JOIN project_relationship on (project_id=object_project_id) JOIN project as trial ON (subject_project_id=trial.project_id) LEFT JOIN projectprop ON (trial.project_id=projectprop.project_id) LEFT JOIN nd_geolocation ON (projectprop.value::INT = nd_geolocation.nd_geolocation_id) WHERE project.project_id =? AND projectprop.type_id=$project_location_type_id  GROUP BY nd_geolocation.nd_geolocation_id,  nd_geolocation.description";
 236
 237
 238         $h = $self->schema()->storage()->dbh()->prepare($q);
 239         $h->execute($breeding_program_id);
 240
 241     }
 242     else {
 243         my $q = "SELECT distinct(nd_geolocation_id), nd_geolocation.description FROM nd_geolocation LEFT JOIN nd_experiment USING(nd_geolocation_id) where nd_experiment_id IS NULL";
 244
 245         $h = $self->schema()->storage()->dbh()->prepare($q);
 246         $h->execute();
 247     }
 248
 249     my @locations;
 250     while (my ($id, $name, $plot_count) = $h->fetchrow_array()) {
 251         push @locations, [ $id, $name, $plot_count ];
 252     }
 253     return \@locations;
 254 }
 255
 256 sub get_all_locations {
 257     my $self = shift;
 258     my $c = shift;
 259
 260     my $rs = $self->schema() -> resultset("NaturalDiversity::NdGeolocation")->search( {}, { order_by => 'description' } );
 261
 262     my @locations = ();
 263     foreach my $loc ($rs->all()) {
 264         push @locations, [ $loc->nd_geolocation_id(), $loc->description() ];
 265     }
 266     return \@locations;
 267
 268 }
 269
 270
 271 sub get_locations {
 272     my $self = shift;
 273
 274     my @rows = $self->schema()->resultset('NaturalDiversity::NdGeolocation')->all();
 275
 276     my $type_id = $self->schema()->resultset('Cv::Cvterm')->search( { 'name'=>'plot' })->first->cvterm_id;
 277
 278
 279     my @locations = ();
 280     foreach my $row (@rows) {
 281         my $plot_count = "SELECT count(*) from stock join cvterm on(type_id=cvterm_id) join nd_experiment_stock using(stock_id) join nd_experiment using(nd_experiment_id)   where cvterm.name='plot' and nd_geolocation_id=?"; # and sp_person_id=?";
 282         my $sh = $self->schema()->storage()->dbh->prepare($plot_count);
 283         $sh->execute($row->nd_geolocation_id); #, $c->user->get_object->get_sp_person_id);
 284
 285         my ($count) = $sh->fetchrow_array();
 286
 287         #if ($count > 0) {
 288
 289                 push @locations,  [ $row->nd_geolocation_id,
 290                                     $row->description,
 291                                     $row->latitude,
 292                                     $row->longitude,
 293                                     $row->altitude,
 294                                     $count, # number of experiments TBD
 295
 296                 ];
 297     }
 298     return \@locations;
 299
 300 }
 301
 302 sub get_all_years {
 303     my $self = shift;
 304     my $year_cv_id = $self->get_project_year_cvterm_id();
 305     my $rs = $self->schema()->resultset("Project::Projectprop")->search( { type_id=>$year_cv_id }, { distinct => 1, +select => 'value', order_by => { -desc => 'value' }} );
 306     my @years;
 307
 308     foreach my $y ($rs->all()) {
 309         push @years, $y->value();
 310     }
 311     return @years;
 312
 313
 314 }
 315
 316 sub get_accessions_by_breeding_program {
 317
 318
 319 }
 320
 321
 322 sub new_breeding_program {
 323     my $self= shift;
 324     my $name = shift;
 325     my $description = shift;
 326
 327     my $type_id = $self->get_breeding_program_cvterm_id();
 328
 329     my $rs = $self->schema()->resultset("Project::Project")->search(
 330         {
 331             name => $name,
 332         });
 333     if ($rs->count() > 0) {
 334         return "A breeding program with name '$name' already exists.";
 335     }
 336
 337     eval {
 338         my $row = $self->schema()->resultset("Project::Project")->create(
 339             {
 340                 name => $name,
 341                 description => $description,
 342             });
 343
 344         $row->insert();
 345
 346         my $prop_row = $self->schema()->resultset("Project::Projectprop")->create(
 347             {
 348                 type_id => $type_id,
 349                 project_id => $row->project_id(),
 350
 351             });
 352         $prop_row->insert();
 353
 354     };
 355     if ($@) {
 356         return "An error occurred while generating a new breeding program. ($@)";
 357     }
 358
 359 }
 360
 361
 362 sub delete_breeding_program {
 363     my $self = shift;
 364     my $project_id = shift;
 365
 366     my $type_id = $self->get_breeding_program_cvterm_id();
 367
 368     # check if this project entry is of type 'breeding program'
 369     my $prop = $self->schema->resultset("Project::Projectprop")->search(
 370         type_id => $type_id,
 371         project_id => $project_id,
 372         );
 373
 374     if ($prop->count() == 0) {
 375         return 0; # wrong type, return 0.
 376     }
 377
 378     $prop->delete();
 379
 380     my $rs = $self->schema->resultset("Project::Project")->search(
 381         project_id => $project_id,
 382         );
 383
 384     if ($rs->count() > 0) {
 385         my $pprs = $self->schema->resultset("Project::ProjectRelationship")->search(
 386             object_project_id => $project_id,
 387             );
 388
 389         if ($pprs->count()>0) {
 390             $pprs->delete();
 391         }
 392         $rs->delete();
 393         return 1;
 394     }
 395     return 0;
 396 }
 397
 398 sub get_breeding_program_with_trial {
 399     my $self = shift;
 400     my $trial_id = shift;
 401
 402     my $rs = $self->schema->resultset("Project::ProjectRelationship")->search( { subject_project_id => $trial_id });
 403
 404     my $breeding_projects = [];
 405     if (my $row = $rs->next()) {
 406         my $prs = $self->schema->resultset("Project::Project")->search( { project_id => $row->object_project_id() } );
 407         while (my $b = $prs->next()) {
 408             push @$breeding_projects, [ $b->project_id(), $b->name(), $b->description() ];
 409         }
 410     }
 411
 412
 413
 414     return $breeding_projects;
 415 }
 416
 417 sub associate_breeding_program_with_trial {
 418     my $self = shift;
 419     my $breeding_project_id = shift;
 420     my $trial_id = shift;
 421
 422     my $breeding_trial_cvterm_id = $self->get_breeding_trial_cvterm_id();
 423
 424     # to do: check if the two provided IDs are of the proper type
 425
 426     eval {
 427         my $breeding_trial_assoc = $self->schema->resultset("Project::ProjectRelationship")->find (
 428             {
 429                 subject_project_id => $trial_id,
 430                 type_id => $breeding_trial_cvterm_id,
 431             }
 432             );
 433
 434         if ($breeding_trial_assoc) {
 435
 436             $breeding_trial_assoc->object_project_id($breeding_project_id);
 437             $breeding_trial_assoc->update();
 438         }
 439         else {
 440             $breeding_trial_assoc = $self->schema->resultset("Project::ProjectRelationship")->create({
 441                 object_project_id => $breeding_project_id,
 442                 subject_project_id => $trial_id,
 443                 type_id => $breeding_trial_cvterm_id,
 444                                                                                                      });
 445             $breeding_trial_assoc->insert();
 446         }
 447     };
 448     if ($@) {
 449         print STDERR "ERROR: $@\n";
 450         return { error => "An error occurred while storing the breeding program - trial relationship." };
 451     }
 452     return {};
 453 }
 454
 455 sub remove_breeding_program_from_trial {
 456     my $self = shift;
 457     my $breeding_program_id = shift;
 458     my $trial_id = shift;
 459
 460     my $breeding_trial_cvterm_id = $self->get_breeding_trial_cvterm_id();
 461
 462     eval {
 463         my $breeding_trial_assoc_rs = $self->schema->resultset("Project::ProjectRelationship")->search(
 464             {
 465                 object_project_id => $breeding_program_id,
 466                 subject_project_id => $trial_id,
 467                 type_id => $breeding_trial_cvterm_id,
 468             }
 469             );
 470         if (my $row = $breeding_trial_assoc_rs->first()) {
 471             $row->delete();
 472         }
 473     };
 474
 475     if ($@) {
 476         return { error => "An error occurred while deleting a breeding program - trial association. $@" };
 477     }
 478     return {};
 479 }
 480
 481
 482 sub get_breeding_program_cvterm_id {
 483     my $self = shift;
 484
 485     my $breeding_program_cvterm_rs = $self->schema->resultset('Cv::Cvterm')->search( { name => 'breeding_program' });
 486
 487     my $row;
 488
 489     if ($breeding_program_cvterm_rs->count() == 0) {
 490         $row = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'breeding_program','project_property');
 491
 492     }
 493     else {
 494         $row = $breeding_program_cvterm_rs->first();
 495     }
 496
 497     return $row->cvterm_id();
 498 }
 499
 500 sub get_breeding_trial_cvterm_id {
 501     my $self = shift;
 502
 503      my $breeding_trial_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'breeding_program_trial_relationship',  'project_relationship');
 504
 505     return $breeding_trial_cvterm->cvterm_id();
 506
 507 }
 508
 509 sub get_cross_cvterm_id {
 510     my $self = shift;
 511
 512     my $cross_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'cross',  'stock_type');
 513     return $cross_cvterm->cvterm_id();
 514 }
 515
 516 sub _get_design_trial_cvterm_id {
 517     my $self = shift;
 518      my $cvterm = $self->schema->resultset("Cv::Cvterm")
 519       ->find({
 520                      name   => 'design',
 521
 522                     });
 523     return $cvterm->cvterm_id();
 524 }
 525
 526 sub get_project_year_cvterm_id {
 527     my $self = shift;
 528     my $year_cvterm_row = $self->schema->resultset('Cv::Cvterm')->find( { name => 'project year' });
 529     return $year_cvterm_row->cvterm_id();
 530 }
 531
 532 sub get_gt_protocols {
 533     my $self = shift;
 534     my $rs = $self->schema->resultset("NaturalDiversity::NdProtocol")->search( { } );
 535     #print STDERR "NdProtocol resultset rows:\n";
 536     my @protocols;
 537     while (my $row = $rs->next()) {
 538         #print STDERR "Name: " . $row->name() . "\n";
 539         #print STDERR "Name: " . $row->nd_protocol_id() . "\n";
 540         #print STDERR $row;
 541         push @protocols, [ $row->nd_protocol_id(), $row->name()];
 542     }
 543     return \@protocols;
 544 }
 545
 546 1;