lib/SGN/Controller/Cross.pm

   1
   2 =head1 NAME
   3
   4 SGN::Controller::AJAX::Cross - a REST controller class to provide the
   5 backend for objects linked with new cross
   6
   7 =head1 DESCRIPTION
   8
   9 Add submit new cross, etc...
  10
  11 =head1 AUTHOR
  12
  13 Jeremy Edwards <jde22@cornell.edu>
  14 Lukas Mueller <lam87@cornell.edu>
  15
  16
  17 =cut
  18
  19 package SGN::Controller::Cross;
  20
  21 use Moose;
  22
  23 use List::MoreUtils qw /any /;
  24 use Try::Tiny;
  25 use CXGN::Phenome::Schema;
  26 use CXGN::Phenome::Allele;
  27 use CXGN::Chado::Stock;
  28 use CXGN::Page::FormattingHelpers qw/ columnar_table_html info_table_html html_alternate_show /;
  29 use CXGN::Pedigree::AddProgeny;
  30 use Scalar::Util qw(looks_like_number);
  31 use File::Slurp;
  32 use SGN::Model::Cvterm;
  33 use File::Temp;
  34 use File::Basename qw | basename dirname|;
  35 use File::Spec::Functions;
  36
  37 BEGIN { extends 'Catalyst::Controller'; }
  38
  39 has 'schema' => (
  40                  is       => 'rw',
  41                  isa      => 'DBIx::Class::Schema',
  42                  lazy_build => 1,
  43                 );
  44 sub _build_schema {
  45   shift->_app->dbic_schema( 'Bio::Chado::Schema', 'sgn_chado' )
  46 }
  47
  48 sub upload_cross :  Path('/cross/upload_cross')  Args(0) {
  49    my ($self, $c) = @_;
  50    my $upload = $c->req->upload('upload_file');
  51    my $visible_to_role = $c->req->param('visible_to_role');
  52    my $format_type = $c->req->param('format_type');
  53    my $basename = $upload->basename;
  54    my $tempfile = $upload->tempname;
  55    my $header_error;
  56    my %line_errors;
  57    my %upload_data;
  58    my $file_error = 0;
  59    my @contents = split /\n/, $upload->slurp;
  60    print STDERR "loading cross file: $tempfile Basename: $basename $format_type $visible_to_role\n";
  61    $c->stash->{tempfile} = $tempfile;
  62    if ($format_type eq "spreadsheet") {
  63      print STDERR "is spreadsheet \n";
  64
  65      if (!$c->user()) {
  66        print STDERR "User not logged in... not adding crosses.\n";
  67        $c->stash->{rest} = {error => "You need to be logged in to add a cross." };
  68        return;
  69      }
  70
  71     if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles)  ) {
  72         print STDERR "User does not have sufficient privileges.\n";
  73         $c->stash->{rest} = {error =>  "you have insufficient privileges to add a cross." };
  74         return;
  75     }
  76
  77      my $first_line = shift(@contents);
  78      my @first_row = split /\t/, $first_line;
  79      if ($first_row[0] ne 'cross_name' ||
  80          $first_row[1] ne 'cross_type' ||
  81          $first_row[2] ne 'maternal_parent' ||
  82          $first_row[3] ne 'paternal_parent' ||
  83          $first_row[4] ne 'trial' ||
  84          $first_row[5] ne 'location' ||
  85          $first_row[6] ne 'number_of_progeny' ||
  86          $first_row[7] ne 'prefix' ||
  87          $first_row[8] ne 'suffix' ||
  88          $first_row[9] ne 'number_of_flowers' ||
  89          $first_row[10] ne 'number_of_seeds') {
  90        $header_error = "<b>Error in header:</b><br>Header should contain the following tab-delimited fields:<br>cross_name<br>cross_type<br>maternal_parent<br>paternal_parent<br>trial<br>location<br>number_of_progeny<br>prefix<br>suffix<br>number_of_flowers<br>number_of_seeds<br>";
  91        print STDERR "$header_error\n";
  92      }
  93      else {
  94        my $line_number = 0;
  95        foreach my $line (@contents) {
  96          $line_number++;
  97          my @row = split /\t/, $line;
  98          if (scalar(@row) < 6) {
  99            $line_errors{$line_number} = "Line $line_number has too few columns\n";
 100          }
 101          elsif (!$row[0] || !$row[1] || !$row[2] || !$row[3] || !$row[4] || !$row[5]) {
 102            $line_errors{$line_number} = "Line $line_number is missing a required field\n";
 103          }
 104          else {
 105            my %cross;
 106            $cross{'cross_name'} = $row[0];
 107            $cross{'cross_type'} = $row[1];
 108            $cross{'maternal_parent'} = $row[2];
 109            $cross{'paternal_parent'} = $row[3];
 110            $cross{'cross_trial'} = $row[4];
 111            $cross{'cross_location'} = $row[5];
 112            if ($row[5]) {$cross{'number_of_progeny'} = $row[6];}
 113            if ($row[6]) {$cross{'prefix'} = $row[7];}
 114            if ($row[7]) {$cross{'suffix'} = $row[8];}
 115            if ($row[8]) {$cross{'number_of_flowers'} = $row[9];}
 116            if ($row[9]) {$cross{'number_of_seeds'} = $row[10];}
 117            my $line_verification = _verify_cross($c,\%cross, \%line_errors, $line_number);
 118            if ($line_verification) {
 119              print STDERR "Verified\n";
 120              $upload_data{$line_number}=\%cross;
 121            }
 122            else {
 123              print STDERR "Not verified\n";
 124            }
 125          }
 126        }
 127      }
 128
 129 #     $c->stash(
 130 #              tempfile => $tempfile,
 131 #              template => '/breeders_toolbox/upload_crosses_confirm_spreadsheet.mas',
 132 #             );
 133    } elsif ($format_type eq "barcode") {
 134 #     $c->stash(
 135 #              tempfile => $tempfile,
 136 #              template => '/breeders_toolbox/upload_crosses_confirm_barcode.mas',
 137 #             );
 138    }
 139    else {
 140      print STDERR "Upload file format type $format_type not recognized\n";
 141    }
 142
 143    if (%line_errors || $header_error) {
 144
 145
 146      $c->stash(
 147                file_name => $basename,
 148                header_error => $header_error,
 149                line_errors_ref => \%line_errors,
 150                template => '/breeders_toolbox/upload_crosses_file_error.mas',
 151                );
 152      #print STDERR "there are errors in the upload file\n$line_errors_string";
 153    }
 154    else {#file is valid
 155      my $number_of_crosses_added = 0;
 156      my $number_of_unique_parents = 0;
 157      my %unique_parents;
 158      foreach my $line (@contents) {
 159        my %cross;
 160        my @row = split /\t/, $line;
 161        $cross{'cross_name'} = $row[0];
 162        $cross{'cross_type'} = $row[1];
 163        $cross{'maternal_parent'} = $row[2];
 164        $cross{'paternal_parent'} = $row[3];
 165        $cross{'cross_trial'} = $row[4];
 166        $cross{'cross_location'} = $row[5];
 167        if ($row[6]) {
 168          $cross{'number_of_progeny'} = $row[6];
 169        }
 170        if ($row[7]) {
 171          $cross{'prefix'} = $row[7];
 172        }
 173        if ($row[8]) {
 174          $cross{'suffix'} = $row[8];
 175        }
 176        if ($row[9]) {
 177          $cross{'number_of_flowers'} = $row[9];
 178        }
 179        if ($row[10]) {
 180          $cross{'number_of_seeds'} = $row[10];
 181        }
 182        $cross{'visible_to_role'} = $visible_to_role;
 183        _add_cross($c,\%cross);
 184        $number_of_crosses_added++;
 185        $unique_parents{$cross{'maternal_parent'}} = 1;
 186        $unique_parents{$cross{'paternal_parent'}} = 1;
 187      }
 188
 189      foreach my $parent (keys %unique_parents) {
 190        $number_of_unique_parents++;
 191      }
 192      $c->stash(
 193                number_of_crosses_added => $number_of_crosses_added,
 194                number_of_unique_parents => $number_of_unique_parents,
 195                upload_data_ref => \%upload_data,
 196                template => '/breeders_toolbox/upload_crosses_confirm_spreadsheet.mas',
 197               );
 198    }
 199
 200 }
 201
 202 sub _verify_cross {
 203   my $c = shift;
 204   my $cross_ref = shift;
 205   my $error_ref = shift;
 206   my $line_number = shift;
 207   my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 208   my $is_verified = 0;
 209   my $cross_name = $cross_ref->{'cross_name'};
 210   my $cross_type = $cross_ref->{'cross_type'};
 211   my $maternal_parent = $cross_ref->{'maternal_parent'};
 212   my $paternal_parent = $cross_ref->{'paternal_parent'};
 213   my $cross_trial = $cross_ref->{'cross_trial'};
 214   my $cross_location = $cross_ref->{'cross_location'};
 215   my $max_progeny = 20000;
 216   my $max_flowers = 10000;
 217   my $max_seeds = 10000;
 218   #print STDERR "name: ".$cross_ref->{'cross_name'}."\n";
 219   if (! $schema->resultset("Stock::Stock")->find({name=>$maternal_parent,})){
 220     $error_ref->{$line_number} .= "Line number $line_number, Maternal parent $maternal_parent does not exist in database\n <br>";
 221     }
 222   if ($cross_type ne "biparental" && $cross_type ne "self" && $cross_type ne "open" && $cross_type ne "bulk" && $cross_type ne "bulk_self" && $cross_type ne "bulk_open" && $cross_type ne "doubled_haploid") {
 223     $error_ref->{$line_number} .= "Line number $line_number, Cross type $cross_type is not valid\n <br>";
 224   }
 225   if ($cross_type eq "self" || $cross_type eq "bulk_self" || $cross_type eq "doubled_haploid") {
 226     if ($maternal_parent ne $paternal_parent) {
 227       $error_ref->{$line_number} .= "Line number $line_number, maternal and paternal parents must match for cross type $cross_type\n <br>";
 228     }
 229   }
 230   if (! $schema->resultset("Stock::Stock")->find({name=>$paternal_parent,})){
 231     $error_ref->{$line_number} .= "Line number $line_number, Paternal parent $paternal_parent does not exist in database\n <br>";
 232     }
 233   if (! $schema->resultset("Project::Project")->find({name=>$cross_trial,})){
 234     $error_ref->{$line_number} .= "Line number $line_number, Trial $cross_trial does not exist in database\n <br>";
 235     }
 236   if (! $schema->resultset("NaturalDiversity::NdGeolocation")->find({description=>$cross_location,})){
 237     $error_ref->{$line_number} .= "Line number $line_number, Location $cross_location does not exist in database\n <br>";
 238     }
 239   #check that cross name does not already exist
 240   if ($schema->resultset("Stock::Stock")->find({name=>$cross_name})){
 241     $error_ref->{$line_number} .= "Line number $line_number, Cross $cross_name already exists in database\n <br>";
 242   }
 243   if ($cross_ref->{'number_of_progeny'}) {
 244     if ($cross_ref->{'number_of_progeny'}  =~ /^[0-9]+$/) { #is an integer
 245       if ($cross_ref->{'number_of_progeny'} > $max_progeny || $cross_ref->{'number_of_progeny'} < 1) {
 246         $error_ref->{$line_number} .= "Line number $line_number, Number of progeny ". $cross_ref->{'number_of_progeny'}." exceeds the maximum of $max_progeny or is invalid\n <br>";
 247       }
 248     } else {
 249       $error_ref->{$line_number} .= "Line number $line_number, Number of progeny ". $cross_ref->{'number_of_progeny'}." is not an integer\n <br>";
 250     }
 251   }
 252   if ($cross_ref->{'number_of_flowers'}) {
 253     if ($cross_ref->{'number_of_flowers'}  =~ /^[0-9]+$/) { #is an integer
 254       if ($cross_ref->{'number_of_flowers'} > $max_flowers || $cross_ref->{'number_of_flowers'} < 1) {
 255         $error_ref->{$line_number} .= "Line number $line_number, Number of flowers ". $cross_ref->{'number_of_flowers'}." exceeds the maximum of $max_flowers or is invalid\n <br>";
 256       }
 257     } else {
 258       $error_ref->{$line_number} .= "Line number $line_number, Number of flowers ". $cross_ref->{'number_of_flowers'}." is not an integer\n <br>";
 259     }
 260   }
 261   if ($cross_ref->{'number_of_seeds'}) {
 262     if ($cross_ref->{'number_of_seeds'}  =~ /^[0-9]+$/) { #is an integer
 263       if ($cross_ref->{'number_of_seeds'} > $max_seeds || $cross_ref->{'number_of_seeds'} < 1) {
 264         $error_ref->{$line_number} .= "Line number $line_number, Number of seeds ". $cross_ref->{'number_of_seeds'}." exceeds the maximum of $max_seeds or is invalid\n <br>";
 265       }
 266     } else {
 267       $error_ref->{$line_number} .= "Line number $line_number, Number of seeds ". $cross_ref->{'number_of_seeds'}." is not an integer\n <br>";
 268     }
 269   }
 270   if ($cross_ref->{'prefix'} =~ m/\-/) {
 271         $error_ref->{$line_number} .= "Line number $line_number, Prefix ". $cross_ref->{'prefix'}." contains an illegal character: -\n <br>";
 272   }
 273   if ($cross_ref->{'suffix'} =~ m/\-/) {
 274         $error_ref->{$line_number} .= "Line number $line_number, Suffix ". $cross_ref->{'suffix'}." contains an illegal character: -\n <br>";
 275   }
 276   if ($error_ref->{$line_number}) {print $error_ref->{$line_number}."\n";return;} else {return 1;}
 277 }
 278
 279 sub _add_cross {
 280   my $c = shift;
 281   my $cross_ref = shift;
 282   my %cross = %{$cross_ref};
 283   my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 284   my $cross_name = $cross{'cross_name'};
 285   my $cross_type =  $cross{'cross_type'};
 286   my $maternal_parent =  $cross{'maternal_parent'};
 287   my $paternal_parent =  $cross{'paternal_parent'};
 288   my $trial =  $cross{'cross_trial'};
 289   my $location =  $cross{'cross_location'};
 290   my $number_of_progeny = $cross{'number_of_progeny'};#check if exists
 291   my $prefix = $cross{'prefix'};#check if exists
 292   my $suffix = $cross{'suffix'};#check if exists
 293   my $number_of_flowers = $cross{'number_of_flowers'};#check if exists
 294   my $number_of_seeds = $cross{'number_of_seeds'};#check if exists
 295   my $visible_to_role = $cross{'visible_to_role'};
 296   my $geolocation = $schema->resultset("NaturalDiversity::NdGeolocation")->find({description=>$location,});
 297   my $project = $schema->resultset("Project::Project")->find({name=>$trial,});
 298   my $accession_cvterm = SGN::Model::Cvterm->get_cvterm_row($schema, 'accession', 'stock_type');
 299
 300   my $population_cvterm = $schema->resultset("Cv::Cvterm")->find(
 301       { name   => 'cross',
 302       });
 303
 304   my $cross_type_cvterm =  SGN::Model::Cvterm->get_cvterm_row($schema, 'cross_type', 'nd_experiment_property');
 305
 306   my $female_parent_stock = $schema->resultset("Stock::Stock")->find(
 307                                                                      { name       => $maternal_parent,
 308                                                                      } );
 309   my $organism_id = $female_parent_stock->organism_id();
 310
 311   my $male_parent_stock = $schema->resultset("Stock::Stock")->find(
 312                                                                    { name       => $paternal_parent,
 313                                                                    } );
 314   my $population_stock = $schema->resultset("Stock::Stock")->find_or_create(
 315       { organism_id => $organism_id,
 316         name       => $cross_name,
 317         uniquename => $cross_name,
 318         type_id => $population_cvterm->cvterm_id,
 319       } );
 320   my $female_parent =  SGN::Model::Cvterm->get_cvterm_row($schema, 'female_parent', 'stock_relationship');
 321
 322   my $male_parent =  SGN::Model::Cvterm->get_cvterm_row($schema, 'male_parent', 'stock_relationship');
 323
 324   ## change 'cross_name' to a more explicit term
 325
 326   my $population_members =  SGN::Model::Cvterm->get_cvterm_row($schema, 'cross_relationship', 'stock_relationship');
 327
 328   my $visible_to_role_cvterm =  SGN::Model::Cvterm->get_cvterm_row($schema, 'visible_to_role', 'local');
 329
 330   my $number_of_flowers_cvterm =  SGN::Model::Cvterm->get_cvterm_row($schema, 'number_of_flowers', 'nd_experiment_property');
 331
 332   my $number_of_seeds_cvterm =  SGN::Model::Cvterm->get_cvterm_row($schema,'number_of_seeds','nd_experiment_property');
 333
 334   my $experiment = $schema->resultset('NaturalDiversity::NdExperiment')->create(
 335       {
 336           nd_geolocation_id => $geolocation->nd_geolocation_id(),
 337           type_id => $population_cvterm->cvterm_id(),
 338       } );
 339   #link to the project
 340   $experiment->find_or_create_related('nd_experiment_projects', {
 341       project_id => $project->project_id()
 342                                       } );
 343   #link the experiment to the stock
 344   $experiment->find_or_create_related('nd_experiment_stocks' , {
 345       stock_id => $population_stock->stock_id(),
 346       type_id  =>  $population_cvterm->cvterm_id(),
 347                                       });
 348   if ($number_of_flowers) {
 349       #set flower number in experimentprop
 350       $experiment->find_or_create_related('nd_experimentprops' , {
 351           nd_experiment_id => $experiment->nd_experiment_id(),
 352           type_id  =>  $number_of_flowers_cvterm->cvterm_id(),
 353           value  =>  $number_of_flowers,
 354                                           });
 355   }
 356   if ($number_of_seeds) {
 357       #set seed number in experimentprop
 358       $experiment->find_or_create_related('nd_experimentprops' , {
 359           nd_experiment_id => $experiment->nd_experiment_id(),
 360           type_id  =>  $number_of_seeds_cvterm->cvterm_id(),
 361           value  =>  $number_of_seeds,
 362                                           });
 363   }
 364
 365   if ($cross_type) {
 366       $experiment->find_or_create_related('nd_experimentprops' , {
 367           nd_experiment_id => $experiment->nd_experiment_id(),
 368           type_id  =>  $cross_type_cvterm->cvterm_id(),
 369           value  =>  $cross_type,
 370                                           });
 371   }
 372
 373   ############
 374   #if progeny number exists
 375   my $increment = 1;
 376   while ($increment < $number_of_progeny + 1) {
 377       $increment = sprintf "%03d", $increment;
 378     my $stock_name = $prefix.$cross_name."_".$increment.$suffix;
 379     my $accession_stock = $schema->resultset("Stock::Stock")->create(
 380         { organism_id => $organism_id,
 381           name       => $stock_name,
 382           uniquename => $stock_name,
 383           type_id     => $accession_cvterm->cvterm_id,
 384         } );
 385       $accession_stock->find_or_create_related('stock_relationship_objects', {
 386           type_id => $female_parent->cvterm_id(),
 387           object_id => $accession_stock->stock_id(),
 388           subject_id => $female_parent_stock->stock_id(),
 389                                                } );
 390       $accession_stock->find_or_create_related('stock_relationship_objects', {
 391           type_id => $male_parent->cvterm_id(),
 392           object_id => $accession_stock->stock_id(),
 393           subject_id => $male_parent_stock->stock_id(),
 394                                                } );
 395       $accession_stock->find_or_create_related('stock_relationship_objects', {
 396           type_id => $population_members->cvterm_id(),
 397           object_id => $accession_stock->stock_id(),
 398           subject_id => $population_stock->stock_id(),
 399                                                } );
 400       #######################
 401       #link the experiment to the progeny
 402
 403
 404     if ($visible_to_role) {
 405         my $accession_stock_prop = $schema->resultset("Stock::Stockprop")->find_or_create(
 406             { type_id =>$visible_to_role_cvterm->cvterm_id(),
 407               value => $visible_to_role,
 408               stock_id => $accession_stock->stock_id()
 409             });
 410     }
 411       $increment++;
 412
 413   }
 414
 415   if ($@) {
 416       $c->stash->{rest} = { error => "An error occurred: $@"};
 417   }
 418
 419   $c->stash->{rest} = { error => '', };
 420
 421
 422 }
 423
 424 sub make_cross_form :Path("/stock/cross/new") :Args(0) {
 425     my ($self, $c) = @_;
 426     $c->stash->{template} = '/breeders_toolbox/new_cross.mas';
 427     if ($c->user()) {
 428       my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 429       # get projects
 430       my @rows = $schema->resultset('Project::Project')->all();
 431       my @projects = ();
 432       foreach my $row (@rows) {
 433         push @projects, [ $row->project_id, $row->name, $row->description ];
 434       }
 435       $c->stash->{project_list} = \@projects;
 436       @rows = $schema->resultset('NaturalDiversity::NdGeolocation')->all();
 437       my @locations = ();
 438       foreach my $row (@rows) {
 439         push @locations,  [ $row->nd_geolocation_id,$row->description ];
 440       }
 441       $c->stash->{locations} = \@locations;
 442
 443
 444     }
 445     else {
 446       $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 447       return;
 448     }
 449 }
 450
 451
 452 sub make_cross :Path("/stock/cross/generate") :Args(0) {
 453     my ($self, $c) = @_;
 454     $c->stash->{template} = '/breeders_toolbox/progeny_from_crosses.mas';
 455     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 456     my $cross_name = $c->req->param('cross_name');
 457     $c->stash->{cross_name} = $cross_name;
 458     my $trial_id = $c->req->param('trial_id');
 459     $c->stash->{trial_id} = $trial_id;
 460     #my $location = $c->req->param('location_id');
 461     my $maternal = $c->req->param('maternal');
 462     my $paternal = $c->req->param('paternal');
 463     my $prefix = $c->req->param('prefix');
 464     my $suffix = $c->req->param('suffix');
 465     my $progeny_number = $c->req->param('progeny_number');
 466     my $visible_to_role = $c->req->param('visible_to_role');
 467
 468     if (! $c->user()) { # redirect
 469         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 470         return;
 471     }
 472
 473
 474     #check that progeny number is an integer less than maximum allowed
 475     my $maximum_progeny_number = 1000;
 476     if ((! $progeny_number =~ m/^\d+$/) or ($progeny_number > $maximum_progeny_number)){
 477       #redirect to error page?
 478       return;
 479     }
 480
 481     #check that parent names are not blank
 482     if ($maternal eq "" or $paternal eq "") {
 483       return;
 484     }
 485
 486     #check that parents exist in the database
 487     if (! $schema->resultset("Stock::Stock")->find({name=>$maternal,})){
 488       return;
 489     }
 490     if (! $schema->resultset("Stock::Stock")->find({name=>$paternal,})){
 491       return;
 492     }
 493
 494     #check that cross name does not already exist
 495     if ($schema->resultset("Stock::Stock")->find({name=>$cross_name})){
 496       return;
 497     }
 498
 499     #check that progeny do not already exist
 500     if ($schema->resultset("Stock::Stock")->find({name=>$prefix.$cross_name.$suffix."-1",})){
 501       return;
 502     }
 503
 504     my $organism = $schema->resultset("Organism::Organism")->find_or_create(
 505     {
 506         genus   => 'Manihot',
 507         species => 'Manihot esculenta',
 508     } );
 509     my $organism_id = $organism->organism_id();
 510
 511     my $accession_cvterm =  SGN::Model::Cvterm->get_cvterm_row($schema, 'accession', 'stock_type');
 512
 513
 514     my $population_cvterm = $schema->resultset("Cv::Cvterm")->find(
 515       { name   => 'population',
 516     });
 517
 518
 519     my $female_parent_stock = $schema->resultset("Stock::Stock")->find(
 520         { name       => $maternal,
 521         } );
 522
 523     my $male_parent_stock = $schema->resultset("Stock::Stock")->find(
 524             { name       => $paternal,
 525             } );
 526
 527     my $population_stock = $schema->resultset("Stock::Stock")->find_or_create(
 528             { organism_id => $organism_id,
 529               name       => $cross_name,
 530               uniquename => $cross_name,
 531               type_id => $population_cvterm->cvterm_id,
 532             } );
 533       my $female_parent =  SGN::Model::Cvterm->get_cvterm_row($schema, 'female_parent', 'stock_relationship');
 534
 535       my $male_parent =  SGN::Model::Cvterm->get_cvterm_row($schema, 'male_parent', 'stock_relationship');
 536
 537       my $population_members =  SGN::Model::Cvterm->get_cvterm_row($schema, 'cross_name', 'stock_relationship');
 538
 539       my $visible_to_role_cvterm =  SGN::Model::Cvterm->get_cvterm_row($schema,  'visible_to_role', 'local');
 540
 541     my $increment = 1;
 542     while ($increment < $progeny_number + 1) {
 543         my $stock_name = $prefix.$cross_name."-".$increment.$suffix;
 544       my $accession_stock = $schema->resultset("Stock::Stock")->create(
 545             { organism_id => $organism_id,
 546               name       => $stock_name,
 547               uniquename => $stock_name,
 548               type_id     => $accession_cvterm->cvterm_id,
 549             } );
 550       $accession_stock->find_or_create_related('stock_relationship_objects', {
 551                 type_id => $female_parent->cvterm_id(),
 552                 object_id => $accession_stock->stock_id(),
 553                 subject_id => $female_parent_stock->stock_id(),
 554                                                   } );
 555       $accession_stock->find_or_create_related('stock_relationship_objects', {
 556                 type_id => $male_parent->cvterm_id(),
 557                 object_id => $accession_stock->stock_id(),
 558                 subject_id => $male_parent_stock->stock_id(),
 559                                                   } );
 560       $accession_stock->find_or_create_related('stock_relationship_objects', {
 561                 type_id => $population_members->cvterm_id(),
 562                 object_id => $accession_stock->stock_id(),
 563                 subject_id => $population_stock->stock_id(),
 564                                                   } );
 565       if ($visible_to_role ne "") {
 566         my $accession_stock_prop = $schema->resultset("Stock::Stockprop")->find_or_create(
 567                { type_id =>$visible_to_role_cvterm->cvterm_id(),
 568                  value => $visible_to_role,
 569                  stock_id => $accession_stock->stock_id()
 570                  });
 571       }
 572       $increment++;
 573
 574     }
 575     if ($@) {
 576     }
 577 }
 578
 579 sub cross_detail : Path('/cross') Args(1) {
 580     my $self = shift;
 581     my $c = shift;
 582     my $id = shift;
 583     my $cross_type_id = SGN::Model::Cvterm->get_cvterm_row($c->dbic_schema("Bio::Chado::Schema"), 'cross', 'stock_type')->cvterm_id();
 584
 585     #get cross from stock id
 586     my $cross = $c->dbic_schema("Bio::Chado::Schema")->resultset("Stock::Stock")->search( { stock_id => $id, type_id => $cross_type_id } )->first();
 587
 588     if (!$cross) { #or from project id
 589         $cross = $c->dbic_schema("Bio::Chado::Schema")->resultset("Project::Project")->search({ 'me.project_id' => $id })->search_related('nd_experiment_projects')->search_related('nd_experiment')->search_related('nd_experiment_stocks')->search_related('stock', {'stock.type_id'=>$cross_type_id})->first();
 590     }
 591
 592     my $cross_id;
 593
 594     if (!$cross) {
 595         $c->stash->{template} = '/generic_message.mas';
 596         $c->stash->{message} = 'The requested cross does not exist.';
 597         return;
 598     } else {
 599         $cross_id = $cross->stock_id();
 600     }
 601
 602     #print STDERR "Cross stock_id is $cross_id\n";
 603
 604     my $progeny = $c->dbic_schema("Bio::Chado::Schema")->resultset("Stock::StockRelationship") -> search( { object_id => $cross_id, 'type.name' => 'offspring_of'  }, { join =>  'type' } );
 605
 606     my $progeny_count = $progeny->count();
 607
 608     $c->stash->{cross_name} = $cross->uniquename();
 609     $c->stash->{user_id} = $c->user ? $c->user->get_object()->get_sp_person_id() : undef;
 610     $c->stash->{cross_id} = $cross_id;
 611     $c->stash->{progeny_count} = $progeny_count;
 612     $c->stash->{template} = '/breeders_toolbox/cross/index.mas';
 613
 614 }
 615
 616 sub cross_wishlist_download : Path('/cross_wishlist/file_download/') Args(1) {
 617     my $self  =shift;
 618     my $c = shift;
 619     my $file_id = shift;
 620     my $metadata_schema = $c->dbic_schema('CXGN::Metadata::Schema');
 621     my $file_row = $metadata_schema->resultset("MdFiles")->find({file_id => $file_id});
 622     my $file_destination =  catfile($file_row->dirname, $file_row->basename);
 623     my $contents = read_file($file_destination);
 624     my $file_name = $file_row->basename;
 625     $c->res->content_type('Application/xls');
 626     $c->res->header('Content-Disposition', qq[attachment; filename="$file_name"]);
 627     $c->res->body($contents);
 628 }
 629
 630
 631 sub family_name_detail : Path('/family') Args(1) {
 632     my $self = shift;
 633     my $c = shift;
 634     my $id = shift;
 635     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 636     my $family_stock_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'family_name', 'stock_type')->cvterm_id();
 637     my $family_type_id = SGN::Model::Cvterm->get_cvterm_row($schema,  'family_type', 'stock_property')->cvterm_id();
 638
 639     #get family_name from stock id
 640     my $family = $schema->resultset("Stock::Stock")->find( { stock_id => $id, type_id => $family_stock_type_id } );
 641
 642     my $family_id;
 643     my $family_name;
 644     my $family_type;
 645         if (!$family) {
 646         $c->stash->{template} = '/generic_message.mas';
 647         $c->stash->{message} = 'The requested family name does not exist.';
 648         return;
 649     } else {
 650         $family_id = $family->stock_id();
 651         $family_name = $family->uniquename();
 652         my $type = $schema->resultset("Stock::Stockprop")->find({ stock_id => $family_id, type_id => $family_type_id})->value();
 653         if (($type eq 'same_parents') || ($type eq '')){
 654             $family_type = 'This family includes only crosses having the same parental genotypes';
 655         } elsif ($type eq 'reciprocal_parents'){
 656             $family_type = 'This family includes reciprocal crosses';
 657         }
 658     }
 659
 660     $c->stash->{family_name} = $family_name;
 661     $c->stash->{user_id} = $c->user ? $c->user->get_object()->get_sp_person_id() : undef;
 662     $c->stash->{family_id} = $family_id;
 663     $c->stash->{family_type} = $family_type;
 664     $c->stash->{template} = '/breeders_toolbox/cross/family.mas';
 665
 666 }
 667
 668
 669 1;