view release on metacpan or  search on metacpan

lib/Bio/Das/ProServer/SourceAdaptor/bed12.pm  view on Meta::CPAN

       WHERE  name = ?', $self->transport()->tablename();
    my $rows = $self->transport()->query( $query, $name );
    return grep {
      $_->{feature_id} eq $featureid
    } @{ $self->_build_features_from_rows( $rows ) };
  }

  # Querying by group ID and not segment ID
  elsif ( $groupid ) {
    # Assume that the 'name' field refers to the group ID
    $self->{'debug'} && carp $self->dsn.": querying by group ID $groupid";
    my $query = sprintf
      'SELECT chrom, chromStart, chromEnd,
              name, score, strand,
              blockCount, blockSizes, blockStarts
       FROM   %s
       WHERE  name = ?', $self->transport()->tablename();
    my $rows = $self->transport()->query( $query, $groupid );
    # Still need to check that the name field doesn't actually refer to the feature ID
    return grep {
      $_->{group_id} eq $groupid
    } @{ $self->_build_features_from_rows( $rows ) };
  }

  # Querying by segment ID
  elsif ( $segmentid ) {
    $self->{'debug'} && carp $self->dsn.": querying by segment $segmentid:$start,$end";
    my $query = sprintf
      'SELECT chrom, chromStart, chromEnd,
              name, score, strand,
              blockCount, blockSizes, blockStarts
       FROM   %s
       WHERE  chrom = ?', $self->transport()->tablename();
    my @args = ("chr$segmentid");
    if ( defined $start && defined $end ) {
      $query .= ' AND chromEnd >= ? AND chromStart <= ?';
      push @args, $start-1, $end; # BED start position is zero-based
    }
    my $rows = $self->transport()->query( $query, @args );
    return @{ $self->_build_features_from_rows( $rows ) };
  }

  # Not specified... 
  carp $self->dsn.': no segment ID, group ID or feature ID given';
  return ();
}

sub _build_features_from_rows {
  my $self     = shift;
  my $rows     = shift;
  my @features = ();

  for my $row ( @{ $rows } ) {

    defined $row->{'chromStart'} || next;
    my $segment = $row->{'chrom'};
    $segment    =~ s/^chr//mxs;

    # One feature line can represent several features
    if ( my $block_count = $row->{'blockCount'} ) {
      my @block_sizes  = split m/,/mxs, $row->{'blockSizes'} , $block_count;
      my @block_starts = split m/,/mxs, $row->{'blockStarts'}, $block_count;

      my $i = 0;
      while ($i<$block_count) {
        push @features, {
          'segment'    => $segment,
          'start'      => $block_starts[$i] + $row->{'chromStart'} + 1,
          'end'        => $block_starts[$i] + $row->{'chromStart'} + $block_sizes[$i],
          'ori'        => $row->{'strand'},
          'score'      => $row->{'score'},
          'group_id'   => $row->{'name'},
          'feature_id' => $row->{'name'} . q[:] . ++$i,
          'type'       => $row->{'name'},
          'method'     => 'BED conversion',
        };
      }

    } else {
      push @features, {
        'segment'    => $segment,
        'start'      => $row->{'chromStart'} + 1,
        'end'        => $row->{'chromEnd'},
        'ori'        => $row->{'strand'},
        'score'      => $row->{'score'},
        'group_id'   => $row->{'name'},
        'feature_id' => $row->{'name'} . ':1',
        'type'       => $row->{'name'},
        'method'     => 'BED conversion',
      };
    }
  }

  $self->{'debug'} && printf "%s: returning %d features\n", $self->dsn, scalar @features;
  return \@features;
}

1;
__END__

=head1 NAME

Bio::Das::ProServer::SourceAdaptor::bed12

=head1 VERSION

$Revision: 688 $

=head1 SYNOPSIS

  Features by segment:
  <host>/das/<source>/features?segment=X:1,100
  
  Features by group ID:
  <host>/das/<source>/features?group_id=TRAN1
  
  Features by feature ID:
  <host>/das/<source>/features?feature_id=TRAN1:4

=head1 DESCRIPTION

Serves up features DAS responses from BED files.