File Coverage

blib/lib/Bio/Gonzales/Feat/IO/BED.pm

Criterion	Covered	Total	%
statement	44	45	97.7
branch	7	8	87.5
condition	2	2	100.0
subroutine	9	10	90.0
pod	0	2	0.0
total	62	67	92.5

package Bio::Gonzales::Feat::IO::BED;

use Mouse;

use warnings;
use strict;
use Data::Dumper;
use Carp;

use 5.010;

our $VERSION = '0.083'; # VERSION

extends 'Bio::Gonzales::Feat::IO::Base';

has 'parent_handler'  => ( is => 'rw' );
has 'track_name'      => ( is => 'rw', default => 'unknown' );
has _wrote_sth_before => ( is => 'rw' );

sub write_feat {
  my ( $self, @feats ) = @_;
  my $fh = $self->fh;

  $self->_write_header
    unless ( $self->_wrote_sth_before );

  for my $f (@feats) {
    $self->_collect_feat($f);
  }

  return;
}

sub _write_header {
  my ($self) = @_;

  my $fh = $self->fh;
  #get track name right
  my $track_name = $self->track_name;
  say $fh "track name=$track_name";

  $self->_wrote_sth_before(1);
}

sub write_collected_feats {
  confess 'this function is deprecated';
}

override 'close' => sub {
  my ($self) = @_;
  my $fh = $self->fh;

  $self->_connect_feats;
  my $parents = $self->_find_parent_feats;

  for my $p (@$parents) {
    $self->parent_handler->($p) if ( $self->parent_handler );
    print $fh _to_bed($p);
  }

  super;

  return;
};

sub _to_bed {
  my ($f) = @_;

  my $strand;
  if   ( $f->strand < 0 ) { $strand = '-'; }
  else                    { $strand = '+'; }

  #chr_id
  #scf_id
  #start
  #end
  #name
  #score // 0
  #strand +-
  #start (thick) == start
  #end (thick) == end
  #rgb == 0
  #block count
  #block sizes
  #block starts

  my @line
    = ( $f->scf_id, $f->start - 1, $f->end, $f->id, $f->score // 0, $strand, ( $f->start - 1 ), $f->end, 0 );

  my @sf = $f->recurse_subfeats;
  if ( @sf > 0 ) {

    #my %sf = (map { $_->start . '_' . $_->end => $_ } @sf);

    @sf = sort { ( $a->start <=> $b->start ) || ( $b->end <=> $a->end ) } @sf;
    push @line, scalar @sf;

    push @line, join( ',', map { $_->end - $_->start + 1 } @sf );
    push @line, join( ',', map { ( $_->start - $f->start ) } @sf );
  }

  return join( "\t", @line ), "\n";
}

__PACKAGE__->meta->make_immutable;

1;