The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*-Perl-*- Test Harness script for Bioperl
# $Id$

use strict;

BEGIN { 
    use lib '.';
    use Bio::Root::Test;
    
    test_begin(
        -tests => 24,
        -requires_module => 'DB_File'
    );

    use_ok('Bio::SeqFeature::Collection');
    use_ok('Bio::Location::Simple');
    use_ok('Bio::Tools::GFF');
    use_ok('Bio::SeqIO');
}

my $verbose = test_debug();

#First of all we need to create an flat db
my $simple = Bio::SeqIO->new(
    -format => 'genbank',
    -file   =>  test_input_file('AB077698.gb')
);

my @features;
my $seq = $simple->next_seq();
@features = $seq->top_SeqFeatures();
is(scalar @features, 11);

ok my $col = Bio::SeqFeature::Collection->new(-verbose => $verbose);

is($col->add_features( \@features), 11);
my @feat = $col->features_in_range(
    -range => (
        Bio::Location::Simple->new(
            -start  => 100,
            -end    => 300,
            -strand => 1,
        )
    ),
    -contain => 0,
);
is(scalar @feat, 5);
if( $verbose ) {    
    for my $f ( @feat ) {
        print "location: ", $f->location->to_FTstring(), "\n";
    }
}

is(scalar $col->features_in_range(
    -range => (
        Bio::Location::Simple->new(
            -start => 100,
            -end   => 300,
            -strand => -1,
        )
    ),
    -strandmatch => 'ignore',
    -contain => 1,
), 2);

@feat = $col->features_in_range(
    -start => 79,
    -end   => 1145,
    -strand => 1,
    -strandmatch => 'strong',
    -contain => 1
);
is(scalar @feat, 5);
if( $verbose ) {    
    for my $f ( sort { $a->start <=> $b->start} @feat ) {
        print $f->primary_tag, " ", $f->location->to_FTstring(), "\n";
    }
}

is($feat[0]->primary_tag, 'CDS');
ok($feat[0]->has_tag('gene'));

$verbose = 0;
# specify input via -fh or -file
my $gffio = Bio::Tools::GFF->new(
    -file => test_input_file('myco_sites.gff'), 
    -gff_version => 2,
);
@features = ();
# loop over the input stream
while(my $feature = $gffio->next_feature()) {
    # do something with feature
    push @features, $feature;
}
$gffio->close();

is(scalar @features, 412);
$col = Bio::SeqFeature::Collection->new(
    -verbose => $verbose,
    -usefile => 1,
);

ok($col);

is($col->add_features( \@features), 412);

my $r = Bio::Location::Simple->new(
    -start => 67700,
    -end   => 150000,
    -strand => 1,
);

@feat = $col->features_in_range(
    -range => $r,
    -strandmatch => 'ignore',
    -contain => 0,
);

is(scalar @feat, 56);
is($col->feature_count, 412);
my $count = $col->feature_count;
$col->remove_features( [$features[58], $features[60]]);

is( $col->feature_count, 410);
@feat = $col->features_in_range(
    -range => $r,
    -strandmatch => 'ignore',
    -contain => 0,
);
is( scalar @feat, 54);
# add the removed features back in in order to get the collection back to size 

$col->add_features([$features[58], $features[60]]);

# let's randomize so we aren't removing and adding in the same order
# and hopefully randomly deal with a bin's expiration
fy_shuffle(\@features);

for my $f ( @features ) {
    $count--, next unless defined $f;
    $col->remove_features([$f]);
#    ok( $col->feature_count, --$count);
}
is($col->feature_count, 0);

# explicitly destroy old instances above (should clear out any open filehandles
# w/o -keep flag set)
undef $col; 

my $filename = test_output_file();
my $newcollection = Bio::SeqFeature::Collection->new(
    -verbose => $verbose,
    -keep    => 1,
    -file    => $filename,
);
$newcollection->add_features(\@feat);
is($newcollection->feature_count, 54);
undef $newcollection;
ok(-s $filename);
$newcollection = Bio::SeqFeature::Collection->new(
    -verbose => $verbose,
    -file    => $filename,
);
is($newcollection->feature_count, 54);
undef $newcollection;
ok( ! -e $filename);
# without -keep => 1, $filename was deleted as expected.
# to stop Bio::Root::Test complaining that the temp file was already deleted,
# we'll just create it again
open my $TMP, '>', $filename or die "Could not write file '$filename': $!\n";
print $TMP "temp\n";
close $TMP;

if( $verbose ) {
    my @fts =  sort { $a->start <=> $b->start}  
    grep { $r->overlaps($_,'ignore') } @features;
    
    if( $verbose ) {
        for my $f ( @fts ) {
            print $f->primary_tag, "    ", $f->location->to_FTstring(), "\n";
        }
        print "\n";
    }

    my %G = map { ($_,1) } @feat; 
    my $c = 0;
    for my $A ( @fts ) {
        if( ! $G{$A} ) {
            print "missing ", $A->primary_tag, " ", $A->location->to_FTstring(), "\n";
        } else { 
            $c++;
        }
    }
    print "Number of features correctly retrieved $c\n";
    for my $f ( sort { $a->start <=> $b->start} @feat ) {
        print $f->primary_tag, "    ", $f->location->to_FTstring(), "\n";
    }
}

sub fy_shuffle { 
    my $array = shift;
    my $i;
    for( $i = @$array; $i--; ) { 
        my $j = int rand($i+1);
        next if $i==$j;
        @$array[$i,$j] = @$array[$j,$i];
    }
}