view release on metacpan or  search on metacpan

lib/Bio/Tools/Run/BEDTools.pm  view on Meta::CPAN

		}
	}
	
	my $collection = Bio::SeqFeature::Collection->new;
	$collection->add_features(\@features);
	
	return $collection;
}

sub _read_bedpe_line {
	my $feature = shift;
	
	my ($chr1, $start1, $end1, $chr2, $start2, $end2, $name, $score, $strand1, $strand2, @add) =
		split("\cI",$feature);
	$strand1 ||= '.';
	$strand2 ||= '.';
	
	return Bio::SeqFeature::FeaturePair->new( -primary       => $name,
	                                          -seq_id        => $chr1,
	                                          -start         => $start1,
	                                          -end           => $end1,
	                                          -strand        => $strand_translate{$strand1},

	                                          -hprimary_tag  => $name,
	                                          -hseqname      => $chr2,
	                                          -hstart        => $start2,
	                                          -hend          => $end2,
	                                          -hstrand       => $strand_translate{$strand2},
	
	                                          -score         => $score
	                                        );
}

=head2 _validate_file_input()

 Title   : _validate_file_input
 Usage   : $bedtools_fac->_validate_file_input( -type => $file )
 Function: validate file type for file spec
 Returns : file type if valid type for file spec
 Args    : hash of filespec => file_name

=cut

sub _validate_file_input {
	my ($self, @args) = @_;
	my (%args);
	if (grep (/^-/, @args) && (@args > 1)) { # named parms
		$self->throw("Wrong number of args - requires one named arg") if (@args > 2);
		s/^-// for @args;
		%args = @args;
	} else {
		$self->throw("Must provide named filespec");
	}
	
	for (keys %args) {
		m/bam/ && do {
			return 'bam';
		};
		do {
			return unless ( -e $args{$_} && -r _ );
			my $guesser = Bio::Tools::GuessSeqFormat->new(-file=>$args{$_});
			return $guesser->guess if grep {$guesser->guess =~ m/$_/} @{$accepted_types{$_}};
		}
	}
	return;
}

=head2 version()

 Title   : version
 Usage   : $version = $bedtools_fac->version()
 Function: Returns the program version (if available)
 Returns : string representing location and version of the program

=cut

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

	my $cmd = $self->command if $self->can('command');

	defined $cmd or $self->throw("No command defined - cannot determine program executable");

	# new bahaviour for some BEDTools executables - breaks previous approach to getting version
	# $dummy can be any non-recognised parameter - '-version' works for most
	my $dummy = '-version';
	$dummy = '-examples' if $cmd =~ /graph_union/;

	my ($in, $out, $err);
	my $dum;
	$in = \$dum;
	$out = \$self->{'stdout'};
	$err = \$self->{'stderr'};

	# Get program executable
	my $exe = $self->executable;

	my @ipc_args = ( $exe, $dummy );
	
	eval {
		IPC::Run::run(\@ipc_args, $in, $out, $err) or
			die ("There was a problem running $exe : $!");
	};
	# We don't bother trying to catch this: version is returned as an illegal file seek

	my @details = split("\n",$self->stderr);
	(my $version) = grep /^Program: .*$/, @details;
	$version =~ s/^Program: //;

	return $version;
}

sub available_commands { shift->available_parameters('commands') };

sub filespec { shift->available_parameters('filespec') };

1;