IntronSupportingEvidenceAdaptor.pm

Go to the documentation of this file.

=head1 LICENSE
 
See the NOTICE file distributed with this work for additional information
regarding copyright ownership.
 
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
 
     http://www.apache.org/licenses/LICENSE-2.0
 
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 
=cut
 
package Bio::EnsEMBL::DBSQL::IntronSupportingEvidenceAdaptor;
 
=pod
 
 
=head1 CONTACT
 
  Please email comments or questions to the public Ensembl
  developers list at <http://lists.ensembl.org/mailman/listinfo/dev>.
 
  Questions may also be sent to the Ensembl help desk at
  <http://www.ensembl.org/Help/Contact>.
 
=head1 NAME
 
Bio::EnsEMBL::DBSQL::IntronSupportingEvidenceAdaptor
 
=head1 SYNOPSIS
 
  my $isea = $dba->get_IntronSupportingEvidenceAdaptor();
  my $ise = $isea->fetch_by_dbID(1);
  my $ise_array = $dfa->fetch_all();
 
=head1 METHODS
 
=cut
 
use strict;
use warnings;
use base qw/Bio::EnsEMBL::DBSQL::BaseFeatureAdaptor/;
 
use Bio::EnsEMBL::Intron;
use Bio::EnsEMBL::IntronSupportingEvidence;
use Bio::EnsEMBL::DBSQL::BaseAdaptor;
use Bio::EnsEMBL::Utils::Exception qw/throw/;
use Bio::EnsEMBL::Utils::Scalar qw/assert_ref/;
 
=head2 list_linked_transcript_ids
 
  Arg[1]      : Bio::EnsEMBL::IntronSupportingEvidence Evidence to search with
  Example     : my $transcript_ids = @{$isea->list_linked_transcript_ids($ise)};
  Description : Uses the given IntronSupportingEvidence to find all linked
                transcript ids 
  Returntype  : ArrayRef[Integer] of transcript_id
  Exceptions  : Thrown if arguments are not as stated and for DB errors 
 
=cut
 
sub list_linked_transcript_ids {
  my ($self, $sf) = @_;
  assert_ref($sf, 'Bio::EnsEMBL::IntronSupportingEvidence', 'intron_supporting_evidence');
  my $query = <<'SQL';
select transcript_id from transcript_intron_supporting_evidence 
where intron_supporting_evidence_id =? 
SQL
  return $self->dbc()->sql_helper()->execute_simple(-SQL => $query, -PARAMS => [$sf->dbID()]);
}
 
=head2 fetch_all_by_Transcript
 
  Arg[1]      : Bio::EnsEMBL::Transcript Transcript to search with
  Example     : my $ises = $isea->fetch_all_by_Transcript($transcript);
  Description : Uses the given Transcript to search for all instances of
                IntronSupportingEvidence linked to the transcript in the 
                database 
  Returntype  : ArrayRef of IntronSupportingEvidence objects
  Exceptions  : Thrown if arguments are not as stated and for DB errors 
 
=cut
 
sub fetch_all_by_Transcript {
  my ($self, $transcript) = @_;
  assert_ref($transcript, 'Bio::EnsEMBL::Transcript', 'transcript');
  my $query = <<'SQL';
select intron_supporting_evidence_id from transcript_intron_supporting_evidence where transcript_id =?
SQL
  my $ids = $self->dbc()->sql_helper()->execute_simple(-SQL => $query, -PARAMS => [$transcript->dbID()]);
  return $self->fetch_all_by_dbID_list($ids);
}
 
=head2 fetch_flanking_exon_ids
 
  Arg[1]      : Bio::EnsEMBL::IntronSupportingEvidence Evidence to search with
  Arg[2]      : Bio::EnsEMBL::Transcript Transcript to search with
  Example     : my ($prev_id, $next_id) = @{$isea->fetch_flanking_exon_ids($ise, $transcript)};
  Description : Uses the given IntronSupportingEvidence and Transcript to search
                for the recorded previous and next exon database ids 
  Returntype  : ArrayRef 1 row long but with 2 columns representing previous 
                and next IDs respectivly
  Exceptions  : Thrown if arguments are not as stated and for DB errors 
 
=cut
 
sub fetch_flanking_exon_ids {
  my ($self, $sf, $transcript) = @_;
  assert_ref($sf, 'Bio::EnsEMBL::IntronSupportingEvidence', 'intron_supporting_evidence');
  assert_ref($transcript, 'Bio::EnsEMBL::Transcript', 'transcript');
  my $query = <<'SQL';
select previous_exon_id, next_exon_id 
from transcript_intron_supporting_evidence 
where transcript_id =? and intron_supporting_evidence_id =?
SQL
  my $ids = $self->dbc()->sql_helper()->execute(-SQL => $query, -PARAMS => [$transcript->dbID(), $sf->dbID()]);
  return unless @{$ids}; 
  return @{$ids->[0]};
}
 
sub _tables {
  return ( [ 'intron_supporting_evidence', 'ise' ] );
}
 
sub _columns {
  return qw/
    ise.intron_supporting_evidence_id 
    ise.analysis_id 
    ise.seq_region_id ise.seq_region_start ise.seq_region_end ise.seq_region_strand
    ise.hit_name ise.score ise.score_type
    ise.is_splice_canonical
  /;
}
 
# _objs_from_sth
 
#  Arg [1]    : StatementHandle $sth
#  Arg [2]    : Bio::EnsEMBL::AssemblyMapper $mapper
#  Arg [3]    : Bio::EnsEMBL::Slice $dest_slice
#  Description: PROTECTED implementation of abstract superclass method.
#               responsible for the creation of Intron supporting features
#  Returntype : listref of Bio::EnsEMBL::IntronSupportingFeatures in target coordinate system
#  Exceptions : none
#  Caller     : internal
#  Status     : Stable
 
sub _objs_from_sth {
  my ($self, $sth, $mapper, $dest_slice) = @_;
 
  #
  # This code is ugly because an attempt has been made to remove as many
  # function calls as possible for speed purposes.  Thus many caches and
  # a fair bit of gymnastics is used.
  #
  
  my $sa = $self->db()->get_SliceAdaptor();
  my $aa = $self->db()->get_AnalysisAdaptor();
 
  my @features;
  my %analysis_hash;
  my %slice_hash;
  my %sr_name_hash;
  my %sr_cs_hash;
  
  my(
    $id,               $analysis_id,    $seq_region_id,
    $seq_region_start, $seq_region_end, $seq_region_strand,
    $hit_name,         $score,          $score_type,
    $splice_canonical);
 
  $sth->bind_columns(\(
                     $id,               $analysis_id,    $seq_region_id,
                     $seq_region_start, $seq_region_end, $seq_region_strand,
                     $hit_name,         $score,          $score_type,
                     $splice_canonical));
  
  my $dest_slice_start;
  my $dest_slice_end;
  my $dest_slice_strand;
  my $dest_slice_length;
  my $dest_slice_cs;
  my $dest_slice_sr_name;
  my $dest_slice_sr_id;
  my $asma;
 
  if ($dest_slice) {
    $dest_slice_start   = $dest_slice->start();
    $dest_slice_end     = $dest_slice->end();
    $dest_slice_strand  = $dest_slice->strand();
    $dest_slice_length  = $dest_slice->length();
    $dest_slice_cs      = $dest_slice->coord_system();
    $dest_slice_sr_name = $dest_slice->seq_region_name();
    $dest_slice_sr_id   = $dest_slice->get_seq_region_id();
    $asma               = $self->db->get_AssemblyMapperAdaptor();
  }
 
  FEATURE: while($sth->fetch()) {
 
    #get the analysis object
    my $analysis = $analysis_hash{$analysis_id} ||= $aa->fetch_by_dbID($analysis_id);
    $analysis_hash{$analysis_id} = $analysis;
 
    #need to get the internal_seq_region, if present
    $seq_region_id = $self->get_seq_region_id_internal($seq_region_id);
    my $slice = $slice_hash{"ID:".$seq_region_id};
 
    if (!$slice) {
      $slice                            = $sa->fetch_by_seq_region_id($seq_region_id);
      $slice_hash{"ID:".$seq_region_id} = $slice;
      $sr_name_hash{$seq_region_id}     = $slice->seq_region_name();
      $sr_cs_hash{$seq_region_id}       = $slice->coord_system();
    }
 
    #obtain a mapper if none was defined, but a dest_seq_region was
    if(!$mapper && $dest_slice && !$dest_slice_cs->equals($slice->coord_system)) {
      $mapper = $asma->fetch_by_CoordSystems($dest_slice_cs, $slice->coord_system);
    }
 
    my $sr_name = $sr_name_hash{$seq_region_id};
    my $sr_cs   = $sr_cs_hash{$seq_region_id};
 
    #
    # remap the feature coordinates to another coord system
    # if a mapper was provided
    #
 
    if ($mapper) {
 
      if (defined $dest_slice && $mapper->isa('Bio::EnsEMBL::ChainedAssemblyMapper') ) {
        ($seq_region_id, $seq_region_start, $seq_region_end, $seq_region_strand) =
         $mapper->map($sr_name, $seq_region_start, $seq_region_end, $seq_region_strand, $sr_cs, 1, $dest_slice);
 
      } else {
        ($seq_region_id, $seq_region_start, $seq_region_end, $seq_region_strand) =
         $mapper->fastmap($sr_name, $seq_region_start, $seq_region_end, $seq_region_strand, $sr_cs);
      }
 
      #skip features that map to gaps or coord system boundaries
      next FEATURE if (!defined($seq_region_id));
 
      #get a slice in the coord system we just mapped to
      $slice = $slice_hash{"ID:".$seq_region_id} ||= $sa->fetch_by_seq_region_id($seq_region_id);
    }
 
    #
    # If a destination slice was provided convert the coords.
    #
    if (defined($dest_slice)) {
      my $seq_region_len = $dest_slice->seq_region_length();
 
      if ( $dest_slice_strand == 1 ) {
        $seq_region_start = $seq_region_start - $dest_slice_start + 1;
        $seq_region_end   = $seq_region_end - $dest_slice_start + 1;
 
        if ( $dest_slice->is_circular ) {
        # Handle circular chromosomes.
 
          if ( $seq_region_start > $seq_region_end ) {
            # Looking at a feature overlapping the chromosome origin.
 
            if ( $seq_region_end > $dest_slice_start ) {
              # Looking at the region in the beginning of the chromosome
              $seq_region_start -= $seq_region_len;
            }
            if ( $seq_region_end < 0 ) {
              $seq_region_end += $seq_region_len;
            }
          } else {
            if ($dest_slice_start > $dest_slice_end && $seq_region_end < 0) {
              # Looking at the region overlapping the chromosome
              # origin and a feature which is at the beginning of the
              # chromosome.
              $seq_region_start += $seq_region_len;
              $seq_region_end   += $seq_region_len;
            }
          }
        }
      } else {
 
        my $start = $dest_slice_end - $seq_region_end + 1;
        my $end = $dest_slice_end - $seq_region_start + 1;
 
        if ($dest_slice->is_circular()) {
 
          if ($dest_slice_start > $dest_slice_end) {
            # slice spans origin or replication
 
            if ($seq_region_start >= $dest_slice_start) {
              $end += $seq_region_len;
              $start += $seq_region_len if $seq_region_end > $dest_slice_start;
 
            } elsif ($seq_region_start <= $dest_slice_end) {
              # do nothing
            } elsif ($seq_region_end >= $dest_slice_start) {
              $start += $seq_region_len;
              $end += $seq_region_len;
 
            } elsif ($seq_region_end <= $dest_slice_end) {
              $end += $seq_region_len if $end < 0;
 
            } elsif ($seq_region_start > $seq_region_end) {
              $end += $seq_region_len;
            }
 
          } else {
 
            if ($seq_region_start <= $dest_slice_end and $seq_region_end >= $dest_slice_start) {
              # do nothing
            } elsif ($seq_region_start > $seq_region_end) {
              if ($seq_region_start <= $dest_slice_end) {
                $start -= $seq_region_len;
              } elsif ($seq_region_end >= $dest_slice_start) {
                $end += $seq_region_len;
              }
            }
          }
        }
 
        $seq_region_start = $start;
        $seq_region_end = $end;
        $seq_region_strand *= -1;
 
      } ## end else [ if ( $dest_slice_strand...)]
 
      # Throw away features off the end of the requested slice or on
      # different seq_region.
      if ($seq_region_end < 1
          || $seq_region_start > $dest_slice_length
          || ($dest_slice_sr_id != $seq_region_id)) {
        next FEATURE;
      }
      $slice = $dest_slice;
    }
    
    push( @features,
          $self->_create_feature_fast(
                                    'Bio::EnsEMBL::IntronSupportingEvidence', {
                                      'start'       => $seq_region_start,
                                      'end'         => $seq_region_end,
                                      'strand'      => $seq_region_strand,
                                      'slice'       => $slice,
                                      'analysis'    => $analysis,
                                      'adaptor'     => $self,
                                      'dbID'        => $id,
                                      'hit_name'    => $hit_name,
                                      'score'       => $score,
                                      'score_type'  => $score_type,
                                      'is_splice_canonical' => $splice_canonical,
                                    } ) );
  }
  
  return \@features;
}
 
####### STORAGE
 
=head2 store
 
  Arg[1]      : Bio::EnsEMBL::IntronSupportingEvidence Evidence to store
  Example     : $isea->store($ise);
  Description : Stores the IntronSupportingEvidence in the database. Duplicates
                are ignored.
  Returntype  : Integer The assigned database identifier
  Exceptions  : Thrown if the given object is not a IntronSupportingEvidence, 
                and for any DB exception. 
 
=cut
 
sub store {
  my ($self, $sf) = @_;
  assert_ref($sf, 'Bio::EnsEMBL::IntronSupportingEvidence', 'intron_supporting_feature');
  
  my $db = $self->db();
  
  if($sf->is_stored($db)) {
    return $sf->dbID();
  }
  
  my $analysis = $sf->analysis();
  my $analysis_id = $analysis->is_stored($db) ? $analysis->dbID() : $db->get_AnalysisAdaptor()->store($analysis);
  
  my $seq_region_id;
  ($sf, $seq_region_id) = $self->_pre_store($sf);
 
  my $insert_ignore = $self->insert_ignore_clause();
  my $sql = qq{
${insert_ignore} into intron_supporting_evidence
(analysis_id, seq_region_id, seq_region_start, seq_region_end, seq_region_strand, hit_name, score, score_type, is_splice_canonical)
values (?,?,?,?,?,?,?,?,?)
  };
 
  #Used later on for duplicate entry retrieval
  my $query_params = [
    [$analysis_id, SQL_INTEGER],
    [$seq_region_id, SQL_INTEGER],
    [$sf->start(), SQL_INTEGER],
    [$sf->end(), SQL_INTEGER],
    [$sf->strand(), SQL_INTEGER],
    [$sf->hit_name(), SQL_VARCHAR],
  ];
 
  my $params = [
    @{$query_params},
    [$sf->score(), SQL_FLOAT],
    [$sf->score_type(), SQL_VARCHAR],
    [$sf->is_splice_canonical(), SQL_INTEGER],
  ];
    
  $self->dbc()->sql_helper()->execute_update(-SQL => $sql, -PARAMS => $params, -CALLBACK => sub {
    my ( $sth, $dbh, $rv ) = @_;
    if ($rv > 0) {
      $sf->dbID($self->last_insert_id('intron_supporting_evidence_id', undef, 'intron_supporting_evidence'));
    }
    return;
  });
  $sf->adaptor($self);
  
  if(!$sf->dbID()) {
    my $query = <<'SQL';
select intron_supporting_evidence_id 
from intron_supporting_evidence
where analysis_id =? 
and seq_region_id =? and seq_region_start =? and seq_region_end =?  and seq_region_strand =?
and hit_name =? 
SQL
    my $id = $self->dbc()->sql_helper()->execute_single_result(-SQL => $query, -PARAMS => $query_params);
    $sf->dbID($id);
  }
  
  return $sf->dbID();
}
 
=head2 store_transcript_linkage
 
  Arg[1]      : Bio::EnsEMBL::IntronSupportingEvidence Evidence to link
  Arg[2]      : Bio::EnsEMBL::Transcript Transcript to link
  Arg[3]      : Integer an optional ID to give if the Transcript's own ID is possibly incorrect
  Example     : $isea->store_transcript_linkage($ise, $transcript);
                $isea->store_transcript_linkage($ise, $transcript, $tid);
  Description : Links a Transcript to a portion of Intron evidence
  Returntype  : None
  Exceptions  : Thrown if the given object is not a Transcript, if the 
                transcript is not stored, if the supporting evidence is not
                stored and for any DB exception. 
 
=cut
 
sub store_transcript_linkage {
  my ($self, $sf, $transcript, $transcript_id) = @_;
  assert_ref($sf, 'Bio::EnsEMBL::IntronSupportingEvidence', 'intron_supporting_evidence');
  assert_ref($transcript, 'Bio::EnsEMBL::Transcript', 'transcript');
  
  throw "Cannot perform the link. The IntronSupportingEvidence must be persisted first" unless $sf->is_stored($self->db());
  
  my $insert_ignore = $self->insert_ignore_clause();
  my $sql = qq{
${insert_ignore} into transcript_intron_supporting_evidence
(transcript_id, intron_supporting_evidence_id, previous_exon_id, next_exon_id)
values (?,?,?,?)
  };
 
  my $intron = $sf->get_Intron($transcript);
  my ($previous_exon, $next_exon) = ($intron->prev_Exon(), $intron->next_Exon());
  $transcript_id ||= $transcript->dbID();
  
  my $params = [
    [$transcript_id, SQL_INTEGER],
    [$sf->dbID(), SQL_INTEGER],
    [$previous_exon->dbID(), SQL_INTEGER],
    [$next_exon->dbID(), SQL_INTEGER],
  ];
  $self->dbc()->sql_helper()->execute_update(-SQL => $sql, -PARAMS => $params);
  
  return;
}
 
####### UPDATE
 
=head2 update
 
  Arg[1]      : Bio::EnsEMBL::IntronSupportingEvidence Evidence to update
  Example     : $isea->update($ise);
  Description : Updates all attributes of an evidence object
  Returntype  : None
  Exceptions  : Thrown if the given object is not a IntronSupportingEvidence,
                if the object is not stored and for normal DB errors
 
=cut
 
sub update {
  my ($self, $sf) = @_;
  assert_ref($sf, 'Bio::EnsEMBL::IntronSupportingEvidence', 'intron_supporting_evidence');
  if (! $sf->is_stored($self->db())) {
    throw "Cannot update the supporting evidence if it has not already been stored in this database";
  }
  
  my $params = [
    [$sf->analysis()->dbID(), SQL_INTEGER],
    [$sf->slice()->get_seq_region_id(), SQL_INTEGER],
    [$sf->start(), SQL_INTEGER],
    [$sf->end(), SQL_INTEGER],
    [$sf->strand(), SQL_INTEGER],
    [$sf->hit_name(), SQL_VARCHAR],
    [$sf->score(), SQL_FLOAT],
    [$sf->score_type(), SQL_VARCHAR],
    [$sf->is_splice_canonical() || 0, SQL_INTEGER],
    [$sf->dbID(), SQL_INTEGER],
  ];
  
  my $sql = <<'SQL';
UPDATE intron_supporting_evidence
SET analysis_id =?, seq_region_id =?, seq_region_start =?, 
seq_region_end =?, seq_region_strand =?, hit_name =?, score =?, score_type =?,
is_splice_canonical =?
WHERE intron_supporting_evidence_id =?
SQL
  
  $self->dbc()->sql_helper()->execute_update(-SQL => $sql, -PARAMS => $params);
  return;
}
 
####### DELETION
 
=head2 remove
 
  Arg[1]      : Bio::EnsEMBL::IntronSupportingEvidence
  Example           : $isea->remove($ise);
  Description   : Deletes the given IntronSupportingEvidence from the database. 
                This can only occur if the object has no linked transcripts
  Returntype    : None
  Exceptions    : Thrown if the IntronSupportingEvidence is not stored, if
                the object has linked transcripts and in the event of any
                database error
 
=cut
 
sub remove {
  my ($self, $sf) = @_;
  assert_ref($sf, 'Bio::EnsEMBL::IntronSupportingEvidence', 'intron_supporting_evidence');
  if (! $sf->is_stored($self->db())) {
    throw "Cannot delete the supporting evidence if it has not already been stored in this database";
  }
  if($sf->has_linked_transcripts()) {
    throw sprintf('Cannot delete supporting evidence %d. It still has transcripts attached', $sf->dbID());
  }
  $self->dbc()->sql_helper()->execute_update(
    -SQL => 'DELETE from intron_supporting_evidence where intron_supporting_evidence_id =?', 
    -PARAMS => [[$sf->dbID(), SQL_INTEGER]],
  );
  return;
}
 
=head2 remove_all_transcript_linkages
 
  Arg[1]      : Bio::EnsEMBL::IntronSupportingEvidence
  Example     : $isea->remove_all_transcript_linkages($ise);
  Description : Deletes the transcript links to the given IntronSupportingEvidence
  Returntype  : None
  Exceptions  : See remove_transcript_linkage
 
=cut
 
sub remove_all_transcript_linkages {
  my ($self, $sf) = @_;
  foreach my $transcript_id (@{$self->list_linked_transcript_ids($sf)}) {
    $self->_remove_transcript_linkage($sf, $transcript_id);
  }
  return;
}
 
=head2 remove_transcript_linkage
 
  Arg[1]      : Bio::EnsEMBL::IntronSupportingEvidence Evidence to unlink
  Arg[2]      : Bio::EnsEMBL::Transcript Transcript to unlink
  Example     : $isea->remove_transcript_linkages($ise, $transcript);
  Description : Deletes a transcript's link to the given IntronSupportingEvidence
  Returntype  : None
  Exceptions  : Thrown if the given object is not a Transcript, if the 
                transcript is not stored, if the supporting evidence is not
                stored and for any DB exception. 
 
=cut
 
sub remove_transcript_linkage {
  my ($self, $sf, $transcript) = @_;
  assert_ref($transcript, 'Bio::EnsEMBL::Transcript', 'transcript');
  if (! $transcript->is_stored($self->db())) {
    throw "Cannot delete the supporting evidence to transcript linkage if the transcript has not already been stored in this database";
  }
  $self->_remove_transcript_linkage($sf, $transcript->dbID());
  return;
}
 
sub _remove_transcript_linkage {
  my ($self, $sf, $transcript_id) = @_;
  if (! $sf->is_stored($self->db())) {
    throw "Cannot delete the supporting evidence to transcript linkage if the evidence has not already been stored in this database";
  }
  $self->dbc()->sql_helper()->execute_update(
    -SQL => 'DELETE from transcript_intron_supporting_evidence where intron_supporting_evidence_id =? and transcript_id =?', 
    -PARAMS => [[$sf->dbID(), SQL_INTEGER], [$transcript_id, SQL_INTEGER]],
  );
  return;
}
 
1;