t/unit_fixture/CXGN/Pedigree/AddPedigrees.t

   1 ## A test for adding pedigrees
   2 ## Jeremy D. Edwards (jde22@cornell.edu) 2013
   3 ## adapted for fixture, Lukas Mueller, Nov 2, 2014
   4
   5 use strict;
   6 use warnings;
   7
   8 use lib 't/lib';
   9
  10 use SGN::Test::Fixture;
  11
  12 use Test::More;
  13 use Data::Dumper;
  14 #use SGN::Test::WWW::Mechanize;
  15
  16 BEGIN {use_ok('CXGN::Pedigree::AddPedigrees');}
  17 BEGIN {use_ok('CXGN::DB::Connection');}
  18 BEGIN {use_ok('Bio::GeneticRelationships::Pedigree');}
  19 BEGIN {use_ok('Bio::GeneticRelationships::Individual');}
  20 BEGIN {use_ok('CXGN::Cross');}
  21 BEGIN {require_ok('Moose');}
  22
  23 my $test = SGN::Test::Fixture->new();
  24 my $schema = $test->bcs_schema();
  25
  26 # biparental pedigree
  27 #
  28 ok(my $pedigree = Bio::GeneticRelationships::Pedigree->new(name => "XG120251", cross_type => "biparental"),"Create pedigree object");
  29 ok(my $female_parent = Bio::GeneticRelationships::Individual->new(name => 'XG120261'),"Create individual for pedigree");
  30 ok(my $male_parent = Bio::GeneticRelationships::Individual->new(name => 'XG120273'),"Create individual for pedigree");
  31 ok($pedigree->set_female_parent($female_parent), "Set a female parent for a pedigree");
  32 ok($pedigree->set_male_parent($male_parent), "Set a male parent for a pedigree");
  33
  34 # self
  35 #
  36 ok(my $pedigree2 = Bio::GeneticRelationships::Pedigree->new(name => "XG120273", cross_type => "self"),"Create pedigree object");
  37 ok(my $female_parent2 = Bio::GeneticRelationships::Individual->new(name => 'XG120261'),"Create individual for pedigree");
  38 ok(my $male_parent2 = Bio::GeneticRelationships::Individual->new(name => 'XG120261'),"Create individual for pedigree");
  39 ok($pedigree2->set_female_parent($female_parent2), "Set a female parent for a pedigree");
  40 ok($pedigree2->set_male_parent($male_parent2), "Set a male parent for a pedigree");
  41
  42 # unknown male parent
  43 #
  44 ok(my $pedigree3 = Bio::GeneticRelationships::Pedigree->new(name => "XG120251", cross_type => "open"),"Create pedigree object");
  45 ok(my $female_parent3 = Bio::GeneticRelationships::Individual->new(name => 'XG120287'),"Create individual for pedigree");
  46 ok(my $male_parent3 = Bio::GeneticRelationships::Individual->new(name => 'XG120261'),"Create individual for pedigree");
  47 ok($pedigree3->set_female_parent($female_parent3), "Set a female parent for a pedigree");
  48 ###ok($pedigree3->set_male_parent(''), "Set an empty male parent for a pedigree");
  49
  50 # sib
  51 #
  52 ok(my $pedigree4 = Bio::GeneticRelationships::Pedigree->new(name => "XG120261", cross_type => "sib"),"Create pedigree object");
  53 ok(my $female_parent4 = Bio::GeneticRelationships::Individual->new(name => 'XG120287'),"Create individual for pedigree");
  54 ok(my $male_parent4 = Bio::GeneticRelationships::Individual->new(name => 'XG120287'),"Create individual for pedigree");
  55 ok($pedigree4->set_female_parent($female_parent4), "Set a female parent for a pedigree");
  56 ok($pedigree4->set_male_parent($male_parent4), "Set a male parent for a pedigree");
  57
  58 # reselected
  59 #
  60 ok(my $pedigree5 = Bio::GeneticRelationships::Pedigree->new(name => "UG120082", cross_type => "reselected"),"Create pedigree object");
  61 ok(my $female_parent5 = Bio::GeneticRelationships::Individual->new(name => 'UG120081'),"Create individual for pedigree");
  62 ok(my $male_parent5 = Bio::GeneticRelationships::Individual->new(name => 'UG120081'),"Create individual for pedigree");
  63 ok($pedigree5->set_female_parent($female_parent5), "Set a female parent for a pedigree");
  64 ok($pedigree5->set_male_parent($male_parent5), "Set a male parent for a pedigree");
  65
  66 my @pedigrees;
  67 for my $p ($pedigree, $pedigree2, $pedigree3, $pedigree4, $pedigree5) {
  68     push (@pedigrees, $p);
  69 }
  70
  71 ok(my $add_pedigrees = CXGN::Pedigree::AddPedigrees->new(schema => $schema, pedigrees => \@pedigrees),"Create object to add pedigrees");
  72 ok(my $validate_pedigrees = $add_pedigrees->validate_pedigrees(), "Can do validation of pedigrees"); #won't work unless accessions are in the database
  73 ok(!exists($validate_pedigrees->{error}));
  74 ok(my $add_return = $add_pedigrees->add_pedigrees(), "Can save pedigrees");
  75 ok(!exists($add_return->{error}));
  76
  77 print STDERR "Now trying a population as a parent... \n";
  78
  79 my $population_type_id = $test->bcs_schema()->resultset("Cv::Cvterm")->find( { name => 'population' })->cvterm_id();
  80
  81 my $population_row = $test->bcs_schema()->resultset("Stock::Stock")->create(
  82     {
  83         name => 'test_population',
  84         uniquename => 'test_population',
  85         type_id => $population_type_id,
  86     });
  87
  88 #my $open_parent = Bio::GeneticRelationships::Population->new(name => 'test_population');
  89 #my @members = ( 'test_accession3', 'test_accession4');
  90 #$open_parent->set_members(\@members);
  91 ok(my $population_parents = Bio::GeneticRelationships::Individual->new(name => 'test_population'),"Create individual for pop");
  92
  93 my $open_pedigree = Bio::GeneticRelationships::Pedigree->new(name => 'XG120198', cross_type => 'open');
  94 $open_pedigree->set_female_parent($female_parent3);
  95 $open_pedigree->set_male_parent($population_parents);
  96
  97 my $polycross_pedigree = Bio::GeneticRelationships::Pedigree->new(name => 'UG120080', cross_type => 'polycross');
  98 $polycross_pedigree->set_female_parent($female_parent4);
  99 $polycross_pedigree->set_male_parent($population_parents);
 100
 101 my @male_population_pedigrees;
 102 for my $pop ($open_pedigree, $polycross_pedigree) {
 103     push (@male_population_pedigrees, $pop);
 104 }
 105
 106 my $add_open_polycross_pedigree = CXGN::Pedigree::AddPedigrees->new(schema=>$schema, pedigrees => \@male_population_pedigrees);
 107 my $validate_return = $add_open_polycross_pedigree->validate_pedigrees();
 108 print STDERR Dumper $validate_return;
 109 ok($validate_return);
 110 ok(!exists($validate_return->{error}));
 111 my $add_return = $add_open_polycross_pedigree->add_pedigrees();
 112 print STDERR Dumper $add_return;
 113 ok($add_return);
 114 ok(!exists($add_return->{error}));
 115
 116 #check accessions missing pedigree
 117 my $missing_pedigree_result = CXGN::Cross->get_accessions_missing_pedigree($schema);
 118 my $number_of_accessions = scalar @$missing_pedigree_result;
 119 is($number_of_accessions, '456');
 120
 121
 122 done_testing();