view release on metacpan or  search on metacpan

lib/Bio/Graphics/Glyph/decorated_gene.pm  view on Meta::CPAN

sub draw_connectors {
  my $self = shift;
  if ($self->feature->primary_tag eq 'gene') {
      my @parts = $self->parts;
      return if @parts && $parts[0]->feature->primary_tag =~ /rna|transcript|pseudogene/i;
  }
  $self->SUPER::draw_connectors(@_);
}

sub maxdepth {
  my $self = shift;
  my $md   = $self->Bio::Graphics::Glyph::maxdepth;
  return $md if defined $md;
  return 2;
}


sub _subfeat {
  my $class   = shift;
  my $feature = shift;

  if ($feature->primary_tag =~ /^gene/i) {
    my @transcripts;
# 2012-05-14 | CF | filtering for primary tag in get_SeqFeatures not working for GFF memory adaptor; 
#                   all subfeatures are returned for every function call; using alternative function call 
#                   to avoid duplication of transcripts    
#    for my $t (qw/mRNA tRNA snRNA snoRNA miRNA ncRNA pseudogene/) {
#      push @transcripts, $feature->get_SeqFeatures($t);
#    }
	foreach my $t ($feature->get_SeqFeatures)
	{
		push(@transcripts, $t) if ($t->primary_tag =~ /mRNA|tRNA|snRNA|snoRNA|miRNA|ncRNA|pseudogene/);
	}
#    map { print "  ".$_->id."\n" } @transcripts;
    return @transcripts if @transcripts;
    my @features = $feature->get_SeqFeatures;  # no transcripts?! return whatever's there
    return @features if @features;

    # fall back to drawing a solid box if no subparts and level 0
    return ($feature) if $class->{level} == 0;
  }
  elsif ($feature->primary_tag =~ /^CDS/i) {
      my @parts = $feature->get_SeqFeatures();
      return ($feature) if $class->{level} == 0 and !@parts;
      return @parts;
  }

  my @subparts;
  if ($class->option('sub_part')) {
    @subparts = $feature->get_SeqFeatures($class->option('sub_part'));
  }
  elsif ($feature->primary_tag =~ /^mRNA/i) {
    @subparts = $feature->get_SeqFeatures(qw(CDS five_prime_UTR three_prime_UTR UTR));
  }
  else {
    @subparts = $feature->get_SeqFeatures('exon');
  }
 
  # The CDS and UTRs may be represented as a single feature with subparts or as several features
  # that have different IDs. We handle both cases transparently.
  my @result;
  foreach (@subparts) {
    if ($_->primary_tag =~ /CDS|UTR/i) {
      my @cds_seg = $_->get_SeqFeatures;
      if (@cds_seg > 0) { push @result,@cds_seg  } else { push @result,$_ }
    } else {
      push @result,$_;
    }
  }
  # fall back to drawing a solid box if no subparts and level 0
  return ($feature) if $class->{level} == 0 && !@result;

  return @result;
}

#sub _subfeat {
#  my $class   = shift;
#  my $feature = shift;
#  return $feature->get_SeqFeatures('mRNA') if $feature->primary_tag eq 'gene';
#
#  my @subparts;
#  if ($class->option('sub_part')) {
#    @subparts = $feature->get_SeqFeatures($class->option('sub_part'));
#  }
#  else {
#
#    @subparts = $feature->get_SeqFeatures(qw(CDS five_prime_UTR three_prime_UTR UTR));
#  }
# 
#  # The CDS and UTRs may be represented as a single feature with subparts or as several features
#  # that have different IDs. We handle both cases transparently.
#  my @result;
#  foreach (@subparts) {
#    if ($_->primary_tag =~ /CDS|UTR/i) {
#      my @cds_seg = $_->get_SeqFeatures;
#      if (@cds_seg > 0) { push @result,@cds_seg  } else { push @result,$_ }
#    } else {
#      push @result,$_;
#    }
#  }
#  return @result;
#}

1;

__END__

=head1 NAME

Bio::Graphics::Glyph::decorated_gene - A GFF3-compatible gene glyph with protein decorations

=head1 SYNOPSIS

  See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.

=head1 DESCRIPTION

This glyph has the same functionality as L<Bio::Graphics::Glyph::gene>, but uses
L<Bio::Graphics::Glyph::decorated_transcript> instead of the 
L<Bio::Graphics::Glyph::processed_transcript> to render transcripts, which allows
sequence features to be highlighted on top of gene models. This functionality is for example 
useful when one wants to assess how different splice forms of the same gene differ 
in terms of encoded protein features, such as protein domains, signal peptides, or 
transmembrane regions.

See L<Bio::Graphics::Glyph::decorated_transcript> for a detailed description of how 
to provide protein decorations for transcripts.  

=head1 BUGS

=head1 SEE ALSO


L<Bio::Graphics::Glyph::gene>,
L<Bio::Graphics::Glyph::decorated_transcript>

=head1 AUTHOR

Christian Frech E<lt>frech.christian@gmail.comE<gt>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.  See DISCLAIMER.txt for
disclaimers of warranty.

=cut