package EnsEMBL::Web::Object::Feature; use strict; use warnings; no warnings "uninitialized"; use EnsEMBL::Web::Object; use EnsEMBL::Web::Proxy::Object; @EnsEMBL::Web::Object::Feature::ISA = qw(EnsEMBL::Web::Object); use Bio::AlignIO; =head2 sequenceObj Arg[1] : none Example : my $sequence = $seqdata->sequenceObj Description : Gets a sequence stored in the data object Return type : Bio::EnsEmbl::Feature =cut sub data : lvalue { $_[0]->{'_data'}; } sub feature_type : lvalue { my ($self, $p) = @_; if ($p) {$_[0]->{'_feature_type'} = $p} return $_[0]->{'_feature_type' }; } sub feature_id : lvalue { my ($self, $p) = @_; if ($p) {$_[0]->{'_feature_id'} = $p} return $_[0]->{'_feature_id' }; } sub feature_mapped { my $self = shift; my $type = $self->feature_type; my $mapped = $self->{'data'}{'_object'}{$type}[0] =~ /UnmappedObject/ ? 0 : 1; return $mapped; } sub unmapped_detail { my ($self, $detail) = @_; my $type = $self->feature_type; my $value = $self->{'data'}{'_object'}{$type}[0]->$detail; return $value; } sub retrieve_features { my ($self, $feature_type) = @_; my $method; if ($feature_type) { $method = "retrieve_$feature_type"; } else { $method = "retrieve_".$self->feature_type; } return $self->$method() if defined &$method; return []; } sub retrieve_Gene { my $self = shift; my $results = []; foreach my $g (@{$self->Obj->{'Gene'}}) { if (ref($g) =~ /UnmappedObject/) { my $unmapped = $self->unmapped_object($g); push(@$results, $unmapped); } else { push @$results, { 'region' => $g->seq_region_name, 'start' => $g->start, 'end' => $g->end, 'strand' => $g->strand, 'length' => $g->end-$g->start+1, 'extname' => $g->external_name, 'label' => $g->stable_id, 'gene_id' => [ $g->stable_id ], 'extra' => [ $g->description ] } } } return ( $results, ['Description'] ); } sub retrieve_Xref { my $self = shift; my $results = []; foreach my $array (@{$self->Obj->{'Xref'}}) { my $xref = shift @$array; push @$results, { 'label' => $xref->primary_id, 'xref_id' => [ $xref->primary_id ], 'extname' => $xref->display_id, 'extra' => [ $xref->description, $xref->dbname ] }; ## also get genes foreach my $g (@$array) { push @$results, { 'region' => $g->seq_region_name, 'start' => $g->start, 'end' => $g->end, 'strand' => $g->strand, 'length' => $g->end-$g->start+1, 'extname' => $g->external_name, 'label' => $g->stable_id, 'gene_id' => [ $g->stable_id ], 'extra' => [ $g->description ] } } } return ( $results, ['Description'] ); } sub retrieve_OligoProbe { my $self = shift; my $results = []; foreach my $ap (@{$self->Obj->{'OligoProbe'}}) { if (ref($ap) =~ /UnmappedObject/) { my $unmapped = $self->unmapped_object($ap); push(@$results, $unmapped); } else { my $names = join ' ', map { /^(.*):(.*):\2/? "$1:$2" : $_ } sort @{$ap->get_all_complete_names()}; foreach my $f (@{$ap->get_all_OligoFeatures()}) { push @$results, { 'region' => $f->seq_region_name, 'start' => $f->start, 'end' => $f->end, 'strand' => $f->strand, 'length' => $f->end-$f->start+1, 'label' => $names, 'gene_id' => [$names], 'extra' => [ $f->mismatchcount ] } } } } return ( $results, ['Mismatches'] ); } sub coord_systems { my $self = shift; my ($exemplar) = keys(%{$self->Obj}); #warn $self->Obj->{$exemplar}->[0]; return [ map { $_->name } @{ $self->Obj->{$exemplar}->[0]->adaptor->db->get_CoordSystemAdaptor()->fetch_all() } ]; } sub unmapped_object { my ($self, $unmapped) = @_; my $analysis = $unmapped->analysis; #while (my($k, $v) = each (%$analysis)) { # warn "$k = $v"; #} my $result = { 'label' => $unmapped->{'_id_'}, 'reason' => $unmapped->description, 'object' => $unmapped->ensembl_object_type, 'score' => $unmapped->target_score, 'analysis' => $$analysis{'_description'}, }; #while (my($k, $v) = each (%$unmapped)) { # warn "$k = $v"; #} return $result; } sub retrieve_DnaAlignFeature { my ($self, $ftype) = @_; $ftype = 'Dna' unless $ftype; my $results = []; foreach my $f ( @{$self->Obj->{$ftype.'AlignFeature'}} ) { if (ref($f) =~ /UnmappedObject/) { my $unmapped = $self->unmapped_object($f); push(@$results, $unmapped); } else { # next unless ($f->score > 80); my $coord_systems = $self->coord_systems(); my( $region, $start, $end, $strand ) = ( $f->seq_region_name, $f->start, $f->end, $f->strand ); if( $f->coord_system_name ne $coord_systems->[0] ) { foreach my $system ( @{$coord_systems} ) { # warn "Projecting feature to $system"; my $slice = $f->project( $system ); # warn @$slice; if( @$slice == 1 ) { ($region,$start,$end,$strand) = ($slice->[0][2]->seq_region_name, $slice->[0][2]->start, $slice->[0][2]->end, $slice->[0][2]->strand ); last; } } } push @$results, { 'region' => $region, 'start' => $start, 'end' => $end, 'strand' => $strand, 'length' => $f->end-$f->start+1, 'label' => $f->display_id." (@{[$f->hstart]}-@{[$f->hend]})", 'gene_id' => ["@{[$f->hstart]}-@{[$f->hend]}"], 'extra' => [ $f->alignment_length, $f->hstrand * $f->strand, $f->percent_id, $f->score, $f->p_value ] }; } } if ($self->feature_mapped) { return $results, [ 'Alignment length', 'Rel ori', '%id', 'score', 'p-value' ]; } else { return $results; } } sub retrieve_ProteinAlignFeature { return $_[0]->retrieve_DnaAlignFeature('Protein'); } sub retrieve_RegulatoryFactor { my $self = shift; my $results = []; my $flag = 0; foreach my $ap (@{$self->Obj->{'RegulatoryFactor'}}) { my @stable_ids; my $gene_links; my $db_ent = $ap->get_all_DBEntries; foreach ( @{ $db_ent} ) { push @stable_ids, $_->primary_id; $gene_links .= qq(<a href="geneview?gene=$stable_ids[-1]">$stable_ids[-1]</a>); # $flag = 1; } my @extra_results = $ap->analysis->description; $extra_results[0] =~ s/(https?:\/\/\S+[\w\/])/<a rel="external" href="$1">$1<\/a>/ig; unshift (@extra_results, $gene_links);# if $gene_links; push @$results, { 'region' => $ap->seq_region_name, 'start' => $ap->start, 'end' => $ap->end, 'strand' => $ap->strand, 'length' => $ap->end-$ap->start+1, 'label' => $ap->display_label, 'gene_id' => \@stable_ids, 'extra' => \@extra_results, } } my $extras = ["Feature analysis"]; unshift @$extras, "Associated gene";# if $flag; return ( $results, $extras ); } =head2 find_available_features Arg[1] : EnsEMBL::Web::Object::Feature (or EnsEMBL::Web::Proxy::Object) Example : my $avail_features = $obj->find_available_features Description : looks in species_defs for size of feature tables and returns details of those that have entries Return type : arrayref =cut sub find_available_features { my $self = shift; my $species = $self->species; my $species_defs = $self->species_defs; my $all_feature_types = [ {'table'=>'gene',value=>'Gene','text'=>"Gene"}, {'table'=>'oligo_feature','value'=>'OligoProbe','text'=>"OligoProbe"}, {'table'=>'dna_align_feature','value'=>'DnaAlignFeature','text'=>"Sequence Feature"}, {'table'=>'protein_align_feature','value'=>'ProteinAlignFeature','text'=>"Protein Feature"}, {'table'=>'regulatory_feature','value'=>'RegulatoryFactor','text'=>"Regulatory Factor"}, ]; my $used_feature_types = []; foreach my $poss_feature (@$all_feature_types) { if ($species_defs->get_table_size( {-db=>'DATABASE_CORE',-table => $poss_feature->{'table'}},$species )) { push @$used_feature_types, $poss_feature; } } ## quick and dirty - ought to check for MIM in external_db if ($species eq 'Homo_sapiens') { unshift @$used_feature_types, {'text'=>"OMIM Disease/Trait",'value'=>'Xref_MIM','href'=>"/$species/featureview?type=Xref_MIM",'raw'=>1}; } return $used_feature_types; } 1;