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
  19 BEGIN { extends 'Catalyst::Controller::REST' }
  20
  21 __PACKAGE__->config(
  22     default   => 'application/json',
  23     stash_key => 'rest',
  24     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  25    );
  26
  27 sub insert_new_project : Path("/ajax/breeders/project/insert") Args(0) {
  28     my $self = shift;
  29     my $c = shift;
  30
  31     if (! $c->user()) {
  32         $c->stash->{rest} = { error => "You must be logged in to add projects." } ;
  33         return;
  34     }
  35
  36     my $params = $c->req->parameters();
  37
  38     my $schema = $c->dbic_schema('Bio::Chado::Schema');
  39
  40     my $exists = $schema->resultset('Project::Project')->search(
  41         { name => $params->{project_name} }
  42         );
  43
  44     if ($exists > 0) {
  45         $c->stash->{rest} = { error => "This trial name is already used." };
  46         return;
  47     }
  48
  49     my $project = $schema->resultset('Project::Project')->find_or_create(
  50         {
  51             name => $params->{project_name},
  52             description => $params->{project_description},
  53         }
  54         );
  55
  56     my $projectprop_year = $project->create_projectprops( { 'project year' => $params->{year},}, {autocreate=>1}); #cv_name => 'project_property' } );
  57
  58     $c->stash->{rest} = { error => '' };
  59 }
  60
  61 sub get_breeding_programs : Path('/ajax/breeders/all_programs') Args(0) {
  62     my $self = shift;
  63     my $c = shift;
  64
  65     my $po = CXGN::BreedersToolbox::Projects->new( { schema => $c->dbic_schema("Bio::Chado::Schema") });
  66
  67     my $breeding_programs = $po->get_breeding_programs();
  68
  69     $c->stash->{rest} = $breeding_programs;
  70 }
  71
  72 sub new_breeding_program :Path('/breeders/program/new') Args(0) {
  73     my $self = shift;
  74     my $c = shift;
  75     my $name = $c->req->param("name");
  76     my $desc = $c->req->param("desc");
  77
  78     if (!($c->user() || $c->user()->check_roles('submitter'))) {
  79         $c->stash->{rest} = { error => 'You need to be logged in and have sufficient privileges to add a breeding program.' };
  80     }
  81
  82     my $p = CXGN::BreedersToolbox::Projects->new( { schema => $c->dbic_schema("Bio::Chado::Schema") });
  83
  84     my $error = $p->new_breeding_program($name, $desc);
  85
  86     if ($error) {
  87         $c->stash->{rest} = { error => $error };
  88     }
  89     else {
  90         $c->stash->{rest} =  {};
  91     }
  92 }
  93
  94 sub delete_breeding_program :Path('/breeders/program/delete') Args(1) {
  95     my $self = shift;
  96     my $c = shift;
  97     my $program_id = shift;
  98
  99     if ($c->user && ($c->user->check_roles("curator"))) {
 100         my $p = CXGN::BreedersToolbox::Projects->new( { schema => $c->dbic_schema("Bio::Chado::Schema") });
 101         $p->delete_breeding_program($program_id);
 102         $c->stash->{rest} = [ 1 ];
 103     }
 104     else {
 105         $c->stash->{rest} = { error => "You don't have sufficient privileges to delete breeding programs." };
 106     }
 107 }
 108
 109
 110 sub get_breeding_programs_by_trial :Path('/breeders/programs_by_trial/') Args(1) {
 111     my $self = shift;
 112     my $c = shift;
 113     my $trial_id = shift;
 114
 115     my $p = CXGN::BreedersToolbox::Projects->new( { schema => $c->dbic_schema("Bio::Chado::Schema") } );
 116
 117     my $projects = $p->get_breeding_programs_by_trial($trial_id);
 118
 119     $c->stash->{rest} =   { projects => $projects };
 120
 121 }
 122
 123 sub add_data_agreement :Path('/breeders/trial/add/data_agreement') Args(0) {
 124     my $self = shift;
 125     my $c = shift;
 126
 127     my $project_id = $c->req->param('project_id');
 128     my $data_agreement = $c->req->param('text');
 129
 130     if (!$c->user()) {
 131         $c->stash->{rest} = { error => 'You need to be logged in to add a data agreement' };
 132         return;
 133     }
 134
 135     if (!($c->user()->check_roles('curator') || $c->user()->check_roles('submitter'))) {
 136         $c->stash->{rest} = { error => 'You do not have the required privileges to add a data agreement to this trial.' };
 137         return;
 138     }
 139
 140     my $schema = $c->dbic_schema('Bio::Chado::Schema');
 141
 142     my $data_agreement_cvterm_id_rs = $schema->resultset('Cv::Cvterm')->search( { name => 'data_agreement' });
 143
 144     my $type_id;
 145     if ($data_agreement_cvterm_id_rs->count>0) {
 146         $type_id = $data_agreement_cvterm_id_rs->first()->cvterm_id();
 147     }
 148
 149     eval {
 150         my $project_rs = $schema->resultset('Project::Project')->search(
 151             { project_id => $project_id }
 152             );
 153
 154         if ($project_rs->count() == 0) {
 155             $c->stash->{rest} = { error => "No such project $project_id", };
 156             return;
 157         }
 158
 159         my $project = $project_rs->first();
 160
 161         my $projectprop_rs = $schema->resultset("Project::Projectprop")->search( { 'project_id' => $project_id, 'type_id'=>$type_id });
 162
 163         my $projectprop;
 164         if ($projectprop_rs->count() > 0) {
 165             $projectprop = $projectprop_rs->first();
 166             $projectprop->value($data_agreement);
 167             $projectprop->update();
 168             $c->stash->{rest} = { message => 'Updated data agreement.' };
 169         }
 170         else {
 171             $projectprop = $project->create_projectprops( { 'data_agreement' => $data_agreement,}, {autocreate=>1});
 172             $c->stash->{rest} = { message => 'Inserted new data agreement.'};
 173         }
 174     };
 175     if ($@) {
 176         $c->stash->{rest} = { error => $@ };
 177         return;
 178     }
 179 }
 180
 181 sub get_data_agreement :Path('/breeders/trial/data_agreement/get') :Args(0) {
 182     my $self = shift;
 183     my $c = shift;
 184
 185     my $project_id = $c->req->param('project_id');
 186
 187     my $schema = $c->dbic_schema('Bio::Chado::Schema');
 188
 189     my $data_agreement_cvterm_id_rs = $schema->resultset('Cv::Cvterm')->search( { name => 'data_agreement' });
 190
 191     if ($data_agreement_cvterm_id_rs->count() == 0) {
 192         $c->stash->{rest} = { error => "No data agreements have been added yet." };
 193         return;
 194     }
 195
 196     my $type_id = $data_agreement_cvterm_id_rs->first()->cvterm_id();
 197
 198     print STDERR "PROJECTID: $project_id TYPE_ID: $type_id\n";
 199
 200     my $projectprop_rs = $schema->resultset('Project::Projectprop')->search(
 201         { project_id => $project_id, type_id=>$type_id }
 202         );
 203
 204     if ($projectprop_rs->count() == 0) {
 205         $c->stash->{rest} = { error => "No such project $project_id", };
 206         return;
 207     }
 208     my $projectprop = $projectprop_rs->first();
 209     $c->stash->{rest} = { prop_id => $projectprop->projectprop_id(), text => $projectprop->value() };
 210
 211 }
 212
 213 sub get_all_years : Path('/ajax/breeders/trial/all_years' ) Args(0) {
 214     my $self = shift;
 215     my $c = shift;
 216
 217     my $bp = CXGN::BreedersToolbox::Projects->new({ schema => $c->dbic_schema("Bio::Chado::Schema") });
 218     my @years = $bp->get_all_years();
 219
 220     $c->stash->{rest} = { years => \@years };
 221 }
 222
 223 sub get_trial_location : Path('/ajax/breeders/trial/location') Args(1) {
 224     my $self = shift;
 225     my $c = shift;
 226     my $trial_id = shift;
 227
 228     my $t = CXGN::Trial->new(
 229         {
 230             bcs_schema => $c->dbic_schema("Bio::Chado::Schema"),
 231             trial_id => $trial_id
 232         });
 233
 234     if ($t) {
 235         $c->stash->{rest} = { location => $t->get_location() };
 236     }
 237     else {
 238         $c->stash->{rest} = { error => "The trial with id $trial_id does not exist" };
 239
 240     }
 241 }
 242
 243 sub get_trial_type : Path('/ajax/breeders/trial/type') Args(1) {
 244     my $self = shift;
 245     my $c = shift;
 246     my $trial_id = shift;
 247
 248     my $t = CXGN::Trial->new(
 249         {
 250             bcs_schema => $c->dbic_schema("Bio::Chado::Schema"),
 251             trial_id => $trial_id
 252         });
 253
 254     my $type = $t->get_project_type();
 255     $c->stash->{rest} = { type => $type };
 256 }
 257
 258 sub get_all_trial_types : Path('/ajax/breeders/trial/alltypes') Args(0) {
 259     my $self = shift;
 260     my $c = shift;
 261
 262     my @types = CXGN::Trial::get_all_project_types($c->dbic_schema("Bio::Chado::Schema"));
 263
 264     $c->stash->{rest} = { types => \@types };
 265 }
 266
 267
 268 sub get_accession_plots :Path('/ajax/breeders/get_accession_plots') Args(0) {
 269     my $self = shift;
 270     my $c = shift;
 271     my $field_trial = $c->req->param("field_trial");
 272     my $parent_accession = $c->req->param("parent_accession");
 273
 274     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 275     my $field_layout_typeid = $c->model("Cvterm")->get_cvterm_row($schema, "field_layout", "experiment_type")->cvterm_id();
 276     my $dbh = $schema->storage->dbh();
 277
 278     my $trial = $schema->resultset("Project::Project")->find ({name => $field_trial});
 279     my $trial_id = $trial->project_id();
 280
 281     my $cross_accession = $schema->resultset("Stock::Stock")->find ({uniquename => $parent_accession});
 282     my $cross_accession_id = $cross_accession->stock_id();
 283
 284     my $q = "SELECT stock.stock_id, stock.uniquename
 285             FROM nd_experiment_project join nd_experiment on (nd_experiment_project.nd_experiment_id=nd_experiment.nd_experiment_id) AND nd_experiment.type_id= ?
 286             JOIN nd_experiment_stock ON (nd_experiment.nd_experiment_id=nd_experiment_stock.nd_experiment_id)
 287             JOIN stock_relationship on (nd_experiment_stock.stock_id = stock_relationship.subject_id) AND stock_relationship.object_id = ?
 288             JOIN stock on (stock_relationship.subject_id = stock.stock_id)
 289             WHERE nd_experiment_project.project_id= ? ";
 290
 291     my $h = $dbh->prepare($q);
 292     $h->execute($field_layout_typeid, $cross_accession_id, $trial_id, );
 293
 294     my @plots=();
 295     while(my ($plot_id, $plot_name) = $h->fetchrow_array()){
 296
 297       push @plots, [$plot_id, $plot_name];
 298     }
 299     #print STDERR Dumper \@plots;
 300     $c->stash->{rest} = {data=>\@plots};
 301
 302 }
 303
 304
 305 1;