view release on metacpan or  search on metacpan

lib/Bio/ViennaNGS/FeatureIO.pm  view on Meta::CPAN

use Bio::ViennaNGS;
use Moose;
use Carp;
use File::Slurp;
use Bio::ViennaNGS::Bed;
use Bio::ViennaNGS::Feature;
use Bio::ViennaNGS::FeatureChain;
use Bio::ViennaNGS::BedGraphEntry;
use Data::Dumper;
use version; our $VERSION = version->declare("$Bio::ViennaNGS::VERSION");

has 'file' => ( # file path
	       is => 'ro',
	       isa => 'Str',
	       predicate => 'has_file',
	       required => 1,
	      );

has 'filetype' => ( # BED6, BED12, GFF, GTF
		   is => 'ro',
		   isa => 'Str',
		   predicate => 'has_filetype',
		   required => 1,
		  );

has 'instanceOf' => (
		     is => 'rw',
		     isa => 'Str', # BedGraph, ContainerFeature
		     predicate => 'has_instanceOf',
		     required => 1,
		     writer => 'set_instanceOf',
		    );

has 'data' => (
	       is => 'rw',
	       isa => 'ArrayRef',
	       default => sub { [] },
	       traits => ['Array'],
	       predicate => 'has_data',
	       handles => {
			   all    => 'elements',
			   count  => 'count',
			   add    => 'push',
			   pop    => 'pop',
			  },
	      );

has '_entries' => ( # of elements in $self->data
		   is => 'rw',
		   isa => 'Int',
		   predicate => 'nr_entries',
		   init_arg => undef, # make this unsettable via constructor
		   builder => 'count_entries',
		   lazy => 1,
		  );

with 'Bio::ViennaNGS::FeatureBase';

sub BUILD { # call a parser method, depending on $self->instanceOf
  my $self = shift;
  my $this_function = (caller(0))[3];
  my $type;

  confess "ERROR [$this_function] \$self->file not available"
    unless ($self->has_file);
  confess "ERROR [$this_function] \$self->filetype not available"
    unless ($self->has_filetype);
  confess "ERROR [$this_function] \$self->instanceOf not available"
    unless ($self->has_instanceOf);

  if ($self->filetype eq "BedGraph"){
    #carp "INFO  [$this_function] \$self->instanceOf is BedGraph\n";
    $self->parse_bedgraph_file($self->file);
    return $self->data;
  }
  elsif ($self->filetype =~ m/[Bb]ed6/){
    if($self->instanceOf eq "Feature"){
      #carp "INFO  [$this_function] \$self->instanceOf is Feature\n";
      $type=0; # ArrayRef of individual Feature objects
    }
    elsif ($self->instanceOf eq "FeatureChain"){
      #carp "INFO  [$this_function] \$self->instanceOf is FeatureChain\n";
      $type=1; # ArrayRef of FeatureChain objects, one per Feature object
    }
    elsif ($self->instanceOf eq "FeatureChainBlock"){
      #carp "INFO  [$this_function] \$self->instanceOf is FeatureChainBlock\n";
      $type=2; # ArrayRef of the entire block of Features (aka Bed12 from Bed6 block)
    }
    else{
      croak "ERROR [$this_function] Invalid type for \$self->instanceOf: $self->instanceOf";
    }
    $self->parse_bed6_file($self->file,$type);
    return $self->data;
  }
  elsif ($self->filetype =~ m/[Bb]ed12/){
    if($self->instanceOf eq "Bed"){
      #carp "INFO  [$this_function] \$self->instanceOf is Bed\n";
      $type=0; # ArrayRef of individual Bio::ViennaNGS::Bed objects
    }
    else {croak "ERROR [$this_function] currently only 'Bed' is a valid option for \$self->instance";}
    $self->parse_bed12_file($self->file,$type);
    return $self->data;
  }
  else{
    croak "ERROR [$this_function] Invalid type for \$self->filetyp: $self->filetype";
  }
  $self->count_entries();
}

sub count_entries {
  my $self = shift;
  my $cnt = scalar @{$self->data};
  $self->_entries($cnt);
}

# TODO ensure FeatureBase is handled correctly
sub parse_bedgraph_file{
  my ($self,$filename) = @_;
  my $this_function = (caller(0))[3];
  my ($file,$line,$entry,$chr,$start,$end,$val);

  $file =  read_file( $filename, array_ref => 1, chomp =>1 ) ;
  foreach $line (@$file){
    croak "ERROR [$this_function] cannot parse bedGraph input from $filename"
      unless {$line =~ m/^([a-zA-Z0-9._]+)\t(\d+)\t(\d+)\t(-?\d+\.?\d*)$/};
    $chr = $1; $start = $2; $end = $3, $val = $4;
    #print "++ \$chr $chr ++ \$start $start ++ \$end $end ++ \$val $val\n";
    $entry = Bio::ViennaNGS::BedGraphEntry->new(chromosome => $chr,
						start => $start,
						end => $end,
						dataValue => $val);
    push @{$self->data}, $entry;
  }
}

sub parse_bed6_file{
  my ($self,$file,$typ) = @_;
  my $this_function = (caller(0))[3];
  my ($line,$feat,$fc);
  $file = read_file( $file, array_ref => 1, chomp =>1 );

  if ($typ == 2){ # initialize an empty FeatureChain object
    $fc = Bio::ViennaNGS::FeatureChain->new(type => "feature",
					    base => $self->base);
   }

  #  print "********** in parse_bed6: typ= $typ ************\n";
  foreach $line (@$file){
    my @feat = split /\t/,$line;
    $feat = Bio::ViennaNGS::Feature->new(chromosome=>$feat[0],
					 start=>$feat[1],
					 end=>$feat[2],
					 name=>$feat[3],
					 score=>$feat[4],
					 strand=>$feat[5],
					 base=>$self->base);
    if($typ == 0){ # ArrayRef of individual Feature objects
      push @{$self->data}, $feat;
    }
    elsif ($typ == 1) { # ArrayRef of FeatureChain objects, one per Feature object
      $fc = Bio::ViennaNGS::FeatureChain->new(type => "feature",
					      chain => [$feat],
					      base => $self->base);
      push @{$self->data}, $fc;
    }
    elsif($typ == 2){
      $fc->add($feat);
      $fc->count_entries();
    }
    else{
      croak "ERROR [$this_function] don't know how to handle type $typ";
    }
  } #end foreach
  if ($typ == 2) { push @{$self->data}, $fc; }
 # print Dumper($self);
}

sub parse_bed12_file{
  my ($self,$file,$typ) = @_;
  my $this_function = (caller(0))[3];
  my ($line,$feat,$fc);
  $file = read_file( $file, array_ref => 1, chomp =>1 );
  foreach $line (@$file){
    my @mcData = split /\t/,$line;
    if ($typ == 0){ # ArrayRef of Bio::ViennaNGS::Bed objects
      my $bo = Bio::ViennaNGS::Bed->new(chromosome   => $mcData[0],
					start        => $mcData[1],
					end          => $mcData[2],
					name         => $mcData[3],
					score        => $mcData[4],
					strand       => $mcData[5],
					thickStart   => $mcData[6],
					thickEnd     => $mcData[7],
					itemRgb      => $mcData[8],
					blockCount   => $mcData[9],
					blockSizes   => $mcData[10],
					blockStarts  => $mcData[11],
				       );
      push @{$self->data}, $bo;
    }
  }

}

no Moose;

1;

__END__

=head1 NAME

Bio::ViennaNGS::FeatureIO - Versatile I/O interface for Bio::ViennaNGS
feature annotation classes

=head1 SYNOPSIS

  use Bio::ViennaNGS::FeatureIO;

  # initialize a FeatureIO object from a Bed6 file
  my $data_bed = Bio::ViennaNGS::FeatureIO->new(
					       file => "file.bed6",
					       filetype => 'Bed6',
					       instanceOf => 'Feature',
                                               base => 0,
					      );

  # initialize a FeatureIO object from a Bed12 file
  my $data_bed = Bio::ViennaNGS::FeatureIO->new(
					       file => "file.bed12",
					       filetype => 'Bed12',
					       instanceOf => 'Bed',
                                               base => 0,
					      );

  # initialize a FeatureIO object from a bedGraph file
  my $obj = Bio::ViennaNGS::FeatureIO->new(file       => "file.bg",
                                           filetype   => "BedGraph",
                                           instanceOf => "BedGraph",
                                           base => 0,