lib/SGN/View/Feature.pm

   1 package SGN::View::Feature;
   2 use strict;
   3 use warnings;
   4
   5 use base 'Exporter';
   6 use Bio::Seq;
   7 use CXGN::Tools::Text qw/commify_number/;
   8 use CXGN::Tools::Identifiers;
   9
  10
  11 our @EXPORT_OK = qw/
  12     related_stats feature_table
  13     feature_link
  14     infer_residue cvterm_link
  15     organism_link feature_length
  16     mrna_and_protein_sequence
  17     description_featureprop_types
  18     get_description
  19     location_list_html
  20     location_string
  21     location_string_with_strand
  22     type_name
  23 /;
  24
  25 sub type_name {
  26     cvterm_name( shift->type, @_ );
  27 }
  28
  29 sub cvterm_name {
  30     my ($cvt, $caps) = @_;
  31     ( my $n = $cvt->name ) =~ s/_/ /g;
  32     if( $caps ) {
  33         $n =~ s/(\S+)/lc($1) eq $1 ? ucfirst($1) : $1/e;
  34     }
  35     return $n;
  36 }
  37
  38 sub description_featureprop_types {
  39     shift->result_source->schema
  40          ->resultset('Cv::Cvterm')
  41          ->search({
  42              name => [ 'Note',
  43                        'functional_description',
  44                        'Description',
  45                        'description',
  46                      ],
  47            })
  48 }
  49
  50 sub get_description {
  51     my ($feature) = @_;
  52
  53     my $desc_types =
  54         description_featureprop_types( $feature )
  55             ->get_column('cvterm_id')
  56             ->as_query;
  57
  58     my $description =
  59         $feature->search_related('featureprops', {
  60             type_id => { -in => $desc_types },
  61         })->get_column('value')
  62           ->first;
  63
  64     return unless $description;
  65
  66     $description =~ s/(\S+)/my $id = $1; CXGN::Tools::Identifiers::link_identifier($id) || $id/ge;
  67
  68     return $description;
  69 }
  70
  71 sub feature_length {
  72     my ($feature, $featurelocs) = @_;
  73     my @locations = $featurelocs ? $featurelocs->all : $feature->featureloc_features->all;
  74     my $locations = scalar @locations;
  75     my $length = 0;
  76     for my $l (@locations) {
  77         $length += $l->fmax - $l->fmin;
  78     }
  79     # Reference features don't have featureloc's, calculate the length
  80     # directly
  81     if ($length == 0) {
  82         $length = $feature->seqlen,
  83     }
  84     return ($length,$locations);
  85 }
  86
  87 sub location_string {
  88     my ( $id, $start, $end, $strand ) = @_;
  89     if( @_ == 1 ) {
  90         my $loc = shift;
  91         $id     = feature_link($loc->srcfeature);
  92         $start  = $loc->fmin+1;
  93         $end    = $loc->fmax;
  94         $strand = $loc->strand;
  95     }
  96     ( $start, $end ) = ( $end, $start ) if $strand && $strand == -1;
  97     return "$id:$start..$end";
  98 }
  99
 100 sub location_string_with_strand {
 101     location_string( @_ )
 102 }
 103
 104 sub location_list_html {
 105     my ($feature, $featurelocs) = @_;
 106     my @coords = map { location_string($_) }
 107         ( $featurelocs ? $featurelocs->all
 108                        : $feature->featureloc_features->all)
 109         or return '<span class="ghosted">none</span>';
 110     return @coords;
 111 }
 112 sub location_list {
 113     my ($feature, $featurelocs) = @_;
 114     return map { $_->srcfeature->name . ':' . ($_->fmin+1) . '..' . $_->fmax }
 115         ( $featurelocs ? $featurelocs->all
 116                        : $feature->featureloc_features->all );
 117 }
 118
 119 sub related_stats {
 120     my ($features) = @_;
 121     my $stats = { };
 122     my $total = scalar @$features;
 123     for my $f (@$features) {
 124             $stats->{cvterm_link($f->type)}++;
 125     }
 126     my $data = [ ];
 127     for my $k (sort keys %$stats) {
 128         push @$data, [ $stats->{$k}, $k ];
 129     }
 130     if( 1 < scalar keys %$stats ) {
 131         push @$data, [ $total, "<b>Total</b>" ];
 132     }
 133     return $data;
 134 }
 135
 136 sub feature_table {
 137     my ($features) = @_;
 138     my $data = [];
 139     for my $f (@$features) {
 140         my @locations = $f->featureloc_features->all;
 141
 142         # Add a row for every featureloc
 143         for my $loc (@locations) {
 144             my ($start,$end) = ($loc->fmin+1, $loc->fmax);
 145             push @$data, [
 146                 cvterm_link($f->type),
 147                 feature_link($f),
 148                 "$start..$end",
 149                 commify_number( $end-$start+1 ) . " bp",
 150                 $loc->strand == 1 ? '+' : '-',
 151                 $loc->phase || '<span class="ghosted">n/a</span>',
 152             ];
 153         }
 154     }
 155     return $data;
 156 }
 157
 158 sub _feature_search_string {
 159     my ($feature) = @_;
 160     my ($fl) = $feature->featureloc_features;
 161     return '' unless $fl;
 162     return $fl->srcfeature->name . ':'. ($fl->fmin+1) . '..' . $fl->fmax;
 163 }
 164
 165
 166 ### XXX TODO: A lot of these _link and sequence functions need to be
 167 ### moved to controller code.
 168
 169 sub feature_link {
 170     my ($feature) = @_;
 171     return '<span class="ghosted">null</span>' unless $feature;
 172     my $id   = $feature->feature_id;
 173     my $name = $feature->name;
 174     return qq{<a href="/feature/view/id/$id">$name</a>};
 175 }
 176
 177 sub organism_link {
 178     my ($organism) = @_;
 179     my $id      = $organism->organism_id;
 180     my $species = $organism->species;
 181     return qq{<a class="species_binomial" href="/chado/organism.pl?organism_id=$id">$species</a>};
 182 }
 183
 184 sub cvterm_link {
 185     my ( $cvt, $caps ) = @_;
 186     my $name = cvterm_name( $cvt, $caps );
 187     my $id   = $cvt->id;
 188     return qq{<a href="/chado/cvterm.pl?cvterm_id=$id">$name</a>};
 189 }
 190
 191 sub mrna_and_protein_sequence {
 192     my ($mrna_feature) = @_;
 193     my @exon_locations = _exon_rs( $mrna_feature )->all
 194         or return;
 195
 196     my $mrna_seq = Bio::PrimarySeq->new(
 197         -id   => $mrna_feature->name,
 198         -desc => 'spliced cDNA sequence',
 199         -seq  => join( '', map {
 200             $_->srcfeature->subseq( $_->fmin+1, $_->fmax ),
 201          } @exon_locations
 202         ),
 203     );
 204
 205     my $peptide_loc = _peptides_rs( $mrna_feature )->first
 206         or return ( $mrna_seq, undef );
 207
 208     my $trim_fmin = $peptide_loc->fmin         -  $exon_locations[0]->fmin;
 209     my $trim_fmax = $exon_locations[-1]->fmax  -  $peptide_loc->fmax;
 210     if( $trim_fmin || $trim_fmax ) {
 211         $mrna_seq = $mrna_seq->trunc( 1+$trim_fmin, $mrna_seq->length - $trim_fmax );
 212     }
 213
 214     $mrna_seq = $mrna_seq->revcom if $exon_locations[0]->strand == -1;
 215
 216     my $protein_seq = Bio::PrimarySeq->new(
 217         -id   => $mrna_feature->name,
 218         -desc => 'protein sequence',
 219         -seq  => $mrna_seq->seq,
 220        );
 221     $protein_seq = $protein_seq->translate;
 222
 223     return ( $mrna_seq, $protein_seq );
 224 }
 225
 226 sub _peptides_rs {
 227     my ( $mrna_feature ) = @_;
 228
 229     $mrna_feature
 230         ->feature_relationship_objects({
 231             'me.type_id' => {
 232                 -in => _cvterm_rs( $mrna_feature, 'relationship', 'derives_from' )
 233                          ->get_column('cvterm_id')
 234                          ->as_query,
 235             },
 236           })
 237         ->search_related( 'subject', {
 238             'subject.type_id' => {
 239                 -in => _cvterm_rs( $mrna_feature, 'sequence', 'polypeptide' )
 240                          ->get_column('cvterm_id')
 241                          ->as_query,
 242             },
 243            })
 244         ->search_related( 'featureloc_features', {
 245             srcfeature_id => { -not => undef },
 246           },
 247           { prefetch => 'srcfeature',
 248             order_by => 'fmin',
 249           },
 250          );
 251 }
 252
 253 sub _exon_rs {
 254     my ( $mrna_feature ) = @_;
 255
 256     $mrna_feature
 257         ->feature_relationship_objects({
 258             'me.type_id' => {
 259                 -in => _cvterm_rs( $mrna_feature, 'relationship', 'part_of' )
 260                          ->get_column('cvterm_id')
 261                          ->as_query,
 262             },
 263           },
 264           {
 265               prefetch => 'type',
 266           })
 267         ->search_related( 'subject', {
 268             'subject.type_id' => {
 269                 -in => _cvterm_rs( $mrna_feature, 'sequence', 'exon' )
 270                          ->get_column('cvterm_id')
 271                          ->as_query,
 272             },
 273            },
 274            {
 275                prefetch => 'featureloc_features',
 276            })
 277         ->search_related( 'featureloc_features', {
 278             srcfeature_id => { -not => undef },
 279           },
 280           {
 281             prefetch => 'srcfeature',
 282             order_by => 'fmin',
 283           },
 284          )
 285 }
 286
 287 sub _cvterm_rs {
 288     my ( $row, $cv, $cvt ) = @_;
 289
 290     return $row->result_source->schema
 291                ->resultset('Cv::Cv')
 292                ->search({ 'me.name' => $cv })
 293                ->search_related('cvterms', {
 294                    'cvterms.name' => $cvt,
 295                  });
 296 }
 297
 298 1;