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