use Bio::DB::GFF;
# Open the sequence database
my $db = Bio::DB::GFF->new( -adaptor => 'dbi:mysql',
-dsn => 'dbi:mysql:elegans42',
-aggregator => ['transcript','clone'],
);
----------------------------------------------------------------------------
Aggregator method: clone
Main method: -none-
Sub methods: Clone_left_end Clone_right_end Sequence:Genomic_canonical
----------------------------------------------------------------------------
sub aggregate
{ my $self = shift;
my $features = shift;
my $factory = shift;
my $matchsub = $self->match_sub($factory) or return;
my $passthru = $self->passthru_sub($factory);
my $method = $self->get_method;
my (%clones,%types,@result);
for my $feature (@$features) {
if ($feature->group && $matchsub->($feature)) {
if ($feature->method eq 'Sequence' && $feature->source eq 'Genomic_canonical') {
$clones{$feature->group}{canonical} = $feature;
} elsif ($feature->method eq 'Clone_left_end') {
$clones{$feature->group}{left} = $feature;
} elsif ($feature->method eq 'Clone_right_end') {
$clones{$feature->group}{right} = $feature;
}
push @result,$feature if $passthru && $passthru->($feature);
} else {
push @result,$feature;
}
}
for my $clone (keys %clones) {
my $canonical = $clones{$clone}{canonical} or next;
my $duplicate = $canonical->clone; my $source = $duplicate->source;
my $type = $types{$method,$source} ||= Bio::DB::GFF::Typename->new($method,$source);
$duplicate->type($type);
my ($start,$stop) = $duplicate->strand > 0 ? ('start','stop') : ('stop','start');
@{$duplicate}{$start,$stop} =(undef,undef);
$duplicate->{$start} = $clones{$clone}{left}{$start} if exists $clones{$clone}{left};
$duplicate->{$stop} = $clones{$clone}{right}{$stop} if exists $clones{$clone}{right};
$duplicate->method($self->method);
push @result,$duplicate;
}
@$features = @result; } |
None reported.
Lincoln Stein <lstein@cshl.org>.
Copyright (c) 2001 Cold Spring Harbor Laboratory.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.