lib/SGN/Controller/AJAX/BreedersToolbox.pm

   1
   2 package SGN::Controller::AJAX::BreedersToolbox;
   3
   4 use Moose;
   5
   6 use URI::FromHash 'uri';
   7 use Data::Dumper;
   8 use File::Slurp "read_file";
   9
  10 use CXGN::List;
  11 use CXGN::BreedersToolbox::Projects;
  12 use CXGN::BreedersToolbox::Delete;
  13 use CXGN::Trial::TrialDesign;
  14 use CXGN::Trial::TrialCreate;
  15 use CXGN::Stock::StockLookup;
  16 use CXGN::Location;
  17 use Try::Tiny;
  18 use CXGN::Tools::Run;
  19 use CXGN::Dataset;
  20 use CXGN::Dataset::File;
  21
  22
  23 BEGIN { extends 'Catalyst::Controller::REST' }
  24
  25 __PACKAGE__->config(
  26     default   => 'application/json',
  27     stash_key => 'rest',
  28     map       => { 'application/json' => 'JSON' },
  29    );
  30
  31 sub get_breeding_programs : Path('/ajax/breeders/all_programs') Args(0) {
  32     my $self = shift;
  33     my $c = shift;
  34
  35     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
  36     my $po = CXGN::BreedersToolbox::Projects->new( { schema => $c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id) });
  37
  38     my $breeding_programs = $po->get_breeding_programs();
  39
  40     $c->stash->{rest} = $breeding_programs;
  41 }
  42
  43 sub store_breeding_program :Path('/breeders/program/store') Args(0) {
  44     my $self = shift;
  45     my $c = shift;
  46     my $id = $c->req->param("id") || undef;
  47     my $name = $c->req->param("name");
  48     my $desc = $c->req->param("desc");
  49
  50     if (!($c->user() || $c->user()->check_roles('submitter'))) {
  51         $c->stash->{rest} = { error => 'You need to be logged in and have sufficient privileges to add or edit a breeding program.' };
  52     }
  53
  54     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
  55     my $p = CXGN::BreedersToolbox::Projects->new( {
  56         schema => $c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id),
  57         id => $id,
  58         name => $name,
  59         description => $desc,
  60     });
  61
  62     my $program = $p->store_breeding_program();
  63
  64     print STDERR "Program is ".Dumper($program)."\n";
  65
  66     $c->stash->{rest} = $program;
  67
  68 }
  69
  70 sub delete_breeding_program :Path('/breeders/program/delete') Args(1) {
  71     my $self = shift;
  72     my $c = shift;
  73     my $program_id = shift;
  74     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
  75     if ($c->user && ($c->user->check_roles("curator"))) {
  76         my $p = CXGN::BreedersToolbox::Projects->new( { schema => $c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id) });
  77         $p->delete_breeding_program($program_id);
  78         $c->stash->{rest} = [ 1 ];
  79     }
  80     else {
  81         $c->stash->{rest} = { error => "You need to be logged in with curator privileges to delete a breeding program." };
  82     }
  83 }
  84
  85
  86 sub get_breeding_programs_by_trial :Path('/breeders/programs_by_trial/') Args(1) {
  87     my $self = shift;
  88     my $c = shift;
  89     my $trial_id = shift;
  90
  91     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
  92     my $p = CXGN::BreedersToolbox::Projects->new( { schema => $c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id) } );
  93
  94     my $projects = $p->get_breeding_programs_by_trial($trial_id);
  95
  96     $c->stash->{rest} =   { projects => $projects };
  97
  98 }
  99
 100 sub add_data_agreement :Path('/breeders/trial/add/data_agreement') Args(0) {
 101     my $self = shift;
 102     my $c = shift;
 103
 104     my $project_id = $c->req->param('project_id');
 105     my $data_agreement = $c->req->param('text');
 106
 107     if (!$c->user()) {
 108         $c->stash->{rest} = { error => 'You need to be logged in to add a data agreement' };
 109         return;
 110     }
 111
 112     if (!($c->user()->check_roles('curator') || $c->user()->check_roles('submitter'))) {
 113         $c->stash->{rest} = { error => 'You do not have the required privileges to add a data agreement to this trial.' };
 114         return;
 115     }
 116
 117     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 118     my $schema = $c->dbic_schema('Bio::Chado::Schema', undef, $sp_person_id);
 119
 120     my $data_agreement_cvterm_id_rs = $schema->resultset('Cv::Cvterm')->search( { name => 'data_agreement' });
 121
 122     my $type_id;
 123     if ($data_agreement_cvterm_id_rs->count>0) {
 124         $type_id = $data_agreement_cvterm_id_rs->first()->cvterm_id();
 125     }
 126
 127     eval {
 128         my $project_rs = $schema->resultset('Project::Project')->search(
 129             { project_id => $project_id }
 130             );
 131
 132         if ($project_rs->count() == 0) {
 133             $c->stash->{rest} = { error => "No such project $project_id", };
 134             return;
 135         }
 136
 137         my $project = $project_rs->first();
 138
 139         my $projectprop_rs = $schema->resultset("Project::Projectprop")->search( { 'project_id' => $project_id, 'type_id'=>$type_id });
 140
 141         my $projectprop;
 142         if ($projectprop_rs->count() > 0) {
 143             $projectprop = $projectprop_rs->first();
 144             $projectprop->value($data_agreement);
 145             $projectprop->update();
 146             $c->stash->{rest} = { message => 'Updated data agreement.' };
 147         }
 148         else {
 149             $projectprop = $project->create_projectprops( { 'data_agreement' => $data_agreement,}, {autocreate=>1});
 150             $c->stash->{rest} = { message => 'Inserted new data agreement.'};
 151         }
 152     };
 153     if ($@) {
 154         $c->stash->{rest} = { error => $@ };
 155         return;
 156     }
 157 }
 158
 159 sub get_data_agreement :Path('/breeders/trial/data_agreement/get') :Args(0) {
 160     my $self = shift;
 161     my $c = shift;
 162
 163     my $project_id = $c->req->param('project_id');
 164
 165     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 166     my $schema = $c->dbic_schema('Bio::Chado::Schema', undef, $sp_person_id);
 167
 168     my $data_agreement_cvterm_id_rs = $schema->resultset('Cv::Cvterm')->search( { name => 'data_agreement' });
 169
 170     if ($data_agreement_cvterm_id_rs->count() == 0) {
 171         $c->stash->{rest} = { error => "No data agreements have been added yet." };
 172         return;
 173     }
 174
 175     my $type_id = $data_agreement_cvterm_id_rs->first()->cvterm_id();
 176
 177     print STDERR "PROJECTID: $project_id TYPE_ID: $type_id\n";
 178
 179     my $projectprop_rs = $schema->resultset('Project::Projectprop')->search(
 180         { project_id => $project_id, type_id=>$type_id }
 181         );
 182
 183     if ($projectprop_rs->count() == 0) {
 184         $c->stash->{rest} = { error => "No such project $project_id", };
 185         return;
 186     }
 187     my $projectprop = $projectprop_rs->first();
 188     $c->stash->{rest} = { prop_id => $projectprop->projectprop_id(), text => $projectprop->value() };
 189
 190 }
 191
 192 sub get_all_years : Path('/ajax/breeders/trial/all_years' ) Args(0) {
 193     my $self = shift;
 194     my $c = shift;
 195
 196     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 197     my $bp = CXGN::BreedersToolbox::Projects->new({ schema => $c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id) });
 198     my @years = $bp->get_all_years();
 199
 200     $c->stash->{rest} = { years => \@years };
 201 }
 202
 203 sub get_trial_location : Path('/ajax/breeders/trial/location') Args(1) {
 204     my $self = shift;
 205     my $c = shift;
 206     my $trial_id = shift;
 207
 208     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 209     my $t = CXGN::Trial->new(
 210         {
 211             bcs_schema => $c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id),
 212             trial_id => $trial_id
 213         });
 214
 215     if ($t) {
 216         $c->stash->{rest} = { location => $t->get_location() };
 217     }
 218     else {
 219         $c->stash->{rest} = { error => "The trial with id $trial_id does not exist" };
 220
 221     }
 222 }
 223
 224 sub get_trial_type : Path('/ajax/breeders/trial/type') Args(1) {
 225     my $self = shift;
 226     my $c = shift;
 227     my $trial_id = shift;
 228
 229     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 230     my $t = CXGN::Trial->new(
 231         {
 232             bcs_schema => $c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id),
 233             trial_id => $trial_id
 234         });
 235
 236     my $type = $t->get_project_type();
 237     $c->stash->{rest} = { type => $type };
 238 }
 239
 240 sub get_all_trial_types : Path('/ajax/breeders/trial/alltypes') Args(0) {
 241     my $self = shift;
 242     my $c = shift;
 243
 244     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 245     my @types = CXGN::Trial::get_all_project_types($c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id));
 246
 247     $c->stash->{rest} = { types => \@types };
 248 }
 249
 250
 251 sub get_accession_plots :Path('/ajax/breeders/get_accession_plots') Args(0) {
 252     my $self = shift;
 253     my $c = shift;
 254     my $field_trial = $c->req->param("field_trial");
 255     my $parent_accession = $c->req->param("parent_accession");
 256
 257     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 258     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado', $sp_person_id);
 259     my $field_layout_typeid = $c->model("Cvterm")->get_cvterm_row($schema, "field_layout", "experiment_type")->cvterm_id();
 260     my $dbh = $schema->storage->dbh();
 261
 262     my $trial = $schema->resultset("Project::Project")->find ({name => $field_trial});
 263     my $trial_id = $trial->project_id();
 264
 265     my $cross_accession = $schema->resultset("Stock::Stock")->find ({uniquename => $parent_accession});
 266     my $cross_accession_id = $cross_accession->stock_id();
 267
 268     my $q = "SELECT stock.stock_id, stock.uniquename
 269             FROM nd_experiment_project join nd_experiment on (nd_experiment_project.nd_experiment_id=nd_experiment.nd_experiment_id) AND nd_experiment.type_id= ?
 270             JOIN nd_experiment_stock ON (nd_experiment.nd_experiment_id=nd_experiment_stock.nd_experiment_id)
 271             JOIN stock_relationship on (nd_experiment_stock.stock_id = stock_relationship.subject_id) AND stock_relationship.object_id = ?
 272             JOIN stock on (stock_relationship.subject_id = stock.stock_id)
 273             WHERE nd_experiment_project.project_id= ? ";
 274
 275     my $h = $dbh->prepare($q);
 276     $h->execute($field_layout_typeid, $cross_accession_id, $trial_id, );
 277
 278     my @plots=();
 279     while(my ($plot_id, $plot_name) = $h->fetchrow_array()){
 280
 281       push @plots, [$plot_id, $plot_name];
 282     }
 283     #print STDERR Dumper \@plots;
 284     $c->stash->{rest} = {data=>\@plots};
 285
 286 }
 287
 288 sub delete_uploaded_phenotype_files : Path('/ajax/breeders/phenotyping/delete/') Args(1) {
 289     my $self = shift;
 290     my $c = shift;
 291     my $file_id = shift;
 292     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 293     my $schema = $c->dbic_schema('Bio::Chado::Schema', undef, $sp_person_id);
 294     print STDERR "Deleting phenotypes from File ID: $file_id and making file obsolete\n";
 295     my $dbh = $c->dbc->dbh();
 296     my $nd_experiment_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'phenotyping_experiment', 'experiment_type')->cvterm_id();
 297
 298     my $q_search = "
 299         SELECT phenotype_id, nd_experiment_id, file_id
 300         FROM phenotype
 301         JOIN nd_experiment_phenotype using(phenotype_id)
 302         JOIN nd_experiment_stock using(nd_experiment_id)
 303         JOIN nd_experiment using(nd_experiment_id)
 304         LEFT JOIN phenome.nd_experiment_md_files using(nd_experiment_id)
 305         JOIN stock using(stock_id)
 306         WHERE file_id = ?
 307         AND nd_experiment.type_id = $nd_experiment_type_id";
 308
 309     my $h = $dbh->prepare($q_search);
 310     $h->execute($file_id);
 311
 312     my %phenotype_ids_and_nd_experiment_ids_to_delete;
 313     my $count = 0;
 314     while (my ($phenotype_id, $nd_experiment_id, $file_id) = $h->fetchrow_array()) {
 315         push @{$phenotype_ids_and_nd_experiment_ids_to_delete{phenotype_ids}}, $phenotype_id;
 316         push @{$phenotype_ids_and_nd_experiment_ids_to_delete{nd_experiment_ids}}, $nd_experiment_id;
 317         $count++;
 318     }
 319
 320     if ( $count > 0 ) {
 321         my $dir = $c->tempfiles_subdir('/delete_nd_experiment_ids');
 322         my $temp_file_nd_experiment_id = $c->config->{basepath}."/".$c->tempfile( TEMPLATE => 'delete_nd_experiment_ids/fileXXXX');
 323         my $delete_phenotype_values_error = CXGN::Project::delete_phenotype_values_and_nd_experiment_md_values($c->config->{dbhost}, $c->config->{dbname}, $c->config->{dbuser}, $c->config->{dbpass}, $temp_file_nd_experiment_id, $c->config->{basepath}, $schema, \%phenotype_ids_and_nd_experiment_ids_to_delete);
 324         if ($delete_phenotype_values_error) {
 325             die "Error deleting phenotype values ".$delete_phenotype_values_error."\n";
 326         }
 327     }
 328
 329     my $h4 = $dbh->prepare("UPDATE metadata.md_metadata SET obsolete = 1 where metadata_id IN (SELECT metadata_id from metadata.md_files where file_id=?);");
 330     $h4->execute($file_id);
 331     print STDERR "Phenotype file successfully made obsolete (AKA deleted).\n";
 332
 333     my $async_refresh = CXGN::Tools::Run->new();
 334     $async_refresh->run_async("perl " . $c->config->{basepath} . "/bin/refresh_matviews.pl -H " . $c->config->{dbhost} . " -D " . $c->config->{dbname} . " -U " . $c->config->{dbuser} . " -P " . $c->config->{dbpass} . " -m fullview -c");
 335
 336     $c->stash->{rest} = {success => 1};
 337 }
 338
 339 sub progress : Path('/ajax/progress') Args(0) {
 340     my $self = shift;
 341     my $c = shift;
 342
 343     my $trait_id = $c->req->param("trait_id");
 344
 345     print STDERR "Trait id = $trait_id\n";
 346
 347     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 348     my $schema = $c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id);
 349     my $dbh = $schema->storage->dbh();
 350
 351     my $q = "select projectprop.value, avg(phenotype.value::REAL), stddev(phenotype.value::REAL),count(*) from phenotype join cvterm on(cvalue_id=cvterm_id) join nd_experiment_phenotype using(phenotype_id) join nd_experiment_project using(nd_experiment_id) join projectprop using(project_id)  where cvterm.cvterm_id=? and phenotype.value not in ('-', 'miss','#VALUE!','..') and projectprop.type_id=(SELECT cvterm_id FROM cvterm where name='project year') group by projectprop.type_id, projectprop.value order by projectprop.value";
 352
 353     my $h = $dbh->prepare($q);
 354
 355     $h->execute($trait_id);
 356
 357     my $data = [];
 358
 359     while (my ($year, $mean, $stddev, $count) = $h->fetchrow_array()) {
 360         push @$data, [ $year, sprintf("%.2f", $mean), sprintf("%.2f", $stddev), $count ];
 361     }
 362
 363     print STDERR "Data = ".Dumper($data);
 364
 365     $c->stash->{rest} = { data => $data };
 366 }
 367
 368
 369 sub radarGraph : Path('/ajax/radargraph') Args(0) {
 370     my $self = shift;
 371     my $c = shift;
 372     my $dataset_id = $c->req->param('dataset_id');
 373
 374     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 375     my $people_schema = $c->dbic_schema("CXGN::People::Schema", undef, $sp_person_id);
 376     my $schema = $c->dbic_schema("Bio::Chado::Schema", "sgn_chado", $sp_person_id);
 377     my $dbh = $schema->storage->dbh();
 378
 379
 380     # my $stock_id = $c->req->param("stock_id");
 381     # my $cvterm_id = $c->req->param("cvterm_id");
 382
 383     # my $q = 'select accessions.uniquename, cvterm.name, cvterm.cvterm_id, accessions.stock_id, avg(phenotype.value::REAL), stddev(phenotype.value::REAL), count(*)
 384     #         from cvterm
 385     #         join phenotype on(cvalue_id=cvterm_id)
 386     #         join nd_experiment_phenotype using(phenotype_id)
 387     #         join nd_experiment_stock using(nd_experiment_id)
 388     #         join stock using(stock_id)
 389     #         join stock_relationship on(subject_id=stock.stock_id)
 390     #         join stock as accessions on(stock_relationship.object_id=accessions.stock_id)
 391     #         where stock.type_id=76393 and accessions.stock_id=? and cvterm.cvterm_id=? and phenotype.value ~ \'^[0-9]+\.?[0-9]*$\'
 392     #         group by accessions.uniquename, cvterm.name, cvterm.cvterm_id, accessions.stock_id;';
 393     # my $h = $dbh->prepare($q);
 394
 395
 396     my $ds = CXGN::Dataset->new(people_schema => $people_schema, schema => $schema, sp_dataset_id => $dataset_id);
 397     my $trait_list = $ds->retrieve_phenotypes();
 398     my $ds_name = $ds->name();
 399
 400     #print STDERR "Dataset Id = $dataset_id\n";
 401     #print STDERR "Trait List = ".Dumper($trait_list);
 402
 403     $c->stash->{rest} = {
 404         data => \@$trait_list,
 405         name => $ds_name,
 406     };
 407
 408
 409     #print STDERR "Dataset Id = $dataset_id\n";
 410     #print STDERR "Trait List = ".Dumper($trait_list);
 411
 412
 413 }
 414
 415 1;