t/CXGN/Genomic/gss.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use UNIVERSAL qw/isa/;
   5
   6
   7 use CXGN::CDBI::Class::DBI::TestSampler;
   8 BEGIN {
   9   our %config = ( packagename => 'CXGN::Genomic::GSS',
  10                   test_repeats => 50,
  11                   numtests     => 24,
  12                 );
  13
  14 };
  15 our %config;
  16 use Test::More tests => $config{numtests}*$config{test_repeats};
  17
  18 use CXGN::Genomic::GSS;
  19
  20 sub test {
  21   my $dbh = shift;
  22   my $id = shift;
  23
  24   ###test that we can retrieve it
  25   my $gss = $config{packagename}->retrieve($id);
  26   ok( isa( $gss, $config{packagename} ) );
  27
  28   ### check basic data integrity
  29   my @fields = qw/ status flags seq qual call_positions version chromat_id gss_id /;
  30   my $fieldlist = join( ', ', @fields );
  31   my $gss2 = $dbh->selectrow_hashref( <<EOSQL, undef, $id );
  32 SELECT $fieldlist
  33 FROM genomic.gss
  34 WHERE gss_id = ?
  35 EOSQL
  36   foreach my $field (qw/seq qual call_positions version gss_id/) {
  37       my $v1 = $gss->$field;
  38       my $v2 = $gss2->{$field};
  39       ok( !defined $v1 && !defined $v2 || $gss->$field eq $gss2->{$field} );
  40   }
  41
  42   ###test chromat_id
  43   ok( isa($gss->chromat_id, 'CXGN::Genomic::Chromat') );
  44   ok( isa($gss->chromat_object, 'CXGN::Genomic::Chromat') );
  45   ok( $gss->chromat_object->chromat_id == $gss->chromat_id->chromat_id );
  46   ok( $gss->chromat_object->chromat_id == $gss2->{chromat_id} );
  47
  48   ###test gss_submitted_to_genbank
  49   my ($good1,$good2) = (1,1);
  50   foreach my $sub ($gss->gss_submitted_to_genbank_objects) {
  51     $good1 &&= isa($sub,'CXGN::Genomic::GSSSubmittedToGenbank')
  52       or diag 'improper type for gss_submitted_to_genbank object';
  53     $good2 &&= ($sub->gss_id == $gss->gss_id)
  54       or diag $sub->gss_id.'!='.$gss->gss_id;
  55   }
  56   ok( $good1 );
  57   ok( $good2 );
  58
  59   ###test status
  60   #look for any invalid status keys
  61   is( $gss->gen_status_mask($gss->status), $gss2->{status}, 'status is correct');
  62   is( $gss->gen_flags_mask($gss->flags), $gss2->{flags}, 'flags is correct' );
  63   my %validflags = map { $_,1 } @CXGN::Genomic::GSS::otherflags;
  64   my %validstatus = map { $_,1 } @CXGN::Genomic::GSS::statusflags;
  65   ok(! grep {! $validflags{$_} } keys(%{$gss->flags}) );
  66   ok(! grep {! $validstatus{$_} } keys(%{$gss->status}) );
  67
  68   #check status2str and flags2str are at least the right length
  69   ok($gss->status2str == keys(%{$gss->status}));
  70   ok($gss->flags2str == keys(%{$gss->flags}));
  71
  72   ### check that lengths of seqs, quals, and call_positions are all the same
  73   my $seq     = $gss->seq;
  74   my $tseq    = $gss->trimmed_seq;
  75   ok( !defined $_->[0]  || length $_->[1]  == scalar( my @foo = split /\s/, $_->[0] )
  76       , "valid $_->[2]",
  77     ) or diag("seq: '$_->[1]'\n$_->[2]: '$_->[0]'\n")
  78       for [ $gss->qual,           $seq,  'qual'         ],
  79           [ $gss->trimmed_qual,   $tseq, 'trimmed qual' ],
  80           [ $gss->call_positions, $seq,  'call pos'     ];
  81
  82   #check consistency of trimmed_regions by trimming the raw sequence
  83   #with them and seeing if it comes out the same as the trimmed version
  84   $seq = $gss->seq;
  85   my $good3 = 1;
  86   my @trimmed = $gss->trimmed_regions;
  87   my $prevs = 0;
  88   my $prevlen = 0;
  89   foreach my $trim (@trimmed) {
  90     my ($s,$e) = @$trim;
  91     $prevs <= $s or diag 'trimmed_regions not in ascending order';
  92     my $len = $e-$s+1;
  93     substr($seq,$s-$prevlen,$len,''); #splice out parts of $seq
  94     $prevlen = $len;
  95     $prevs = $s;
  96   }
  97   ok($seq eq $gss->trimmed_seq) or
  98 #     diag html_break_string($seq,70,"\n")
  99 #       ."\nis not equal to\n"
 100 #       .html_break_string($gss->trimmed_seq,70,"\n");
 101
 102   ###check the external identifier
 103   ok( index($gss->external_identifier,$gss->chromat_object->clone_read_external_identifier)
 104       != -1
 105     );
 106  SKIP: {
 107     skip($gss->version <= 1,1);
 108     isnt(index($gss->external_identifier,'_$gss->version'),-1);
 109   }
 110
 111   ###check that unixtime doesn't crash: this could use some work
 112   $gss->unixtime;
 113
 114   ###check to_bio_seq
 115   my $bseq = $gss->to_bio_seq(
 116     -factory => Bio::Seq::SeqFactory->new( -type => 'Bio::Seq::CXGNGenomic' )
 117                              );
 118   #check seqs the same
 119   ok($bseq->seq eq $gss->seq) or
 120 #     diag html_break_string($bseq->seq,70,"\n")
 121 #       ."\nis not equal to\n"
 122 #       .html_break_string($gss->seq,70,"\n");
 123
 124   #check that quals the same
 125   ok(join(' ',@{$bseq->qual}) eq $gss->qual) or
 126 #     diag html_break_string(join(' ',@{$bseq->qual}),70,"\n")
 127 #       ."\nis not equal to\n"
 128 #       .html_break_string($gss->qual,70,"\n");
 129
 130   #check the display_id is the external_identifier
 131   ok($bseq->display_id eq $gss->external_identifier);
 132
 133 }#end test subroutine
 134
 135 #now run the actual sampled test
 136 my $tester = CXGN::CDBI::Class::DBI::TestSampler->new;
 137
 138 $tester->test_class($config{packagename},
 139                     $config{test_repeats},
 140                     \&test);
 141
 142 $tester->disconnect(42);
 143
 144
 145
 146