App-RL
view release on metacpan or search on metacpan
lib/App/RL/Command/position.pm view on Meta::CPAN
package App::RL::Command::position;
use strict;
use warnings;
use autodie;
use App::RL -command;
use App::RL::Common;
sub abstract {
return 'compare runlists against positions';
}
sub opt_spec {
return (
[ "outfile|o=s", "output filename. [stdout] for screen" ],
[ "op=s", "operations: overlap, non-overlap or superset", { default => "overlap" } ],
[ "remove|r", "remove 'chr0' from chromosome names" ],
{ show_defaults => 1, }
);
}
sub usage_desc {
return "runlist position [options] <runlist file> <position file>";
}
sub description {
my $desc;
$desc .= ucfirst(abstract) . ".\n";
$desc .= <<'MARKDOWN';
Genome positions:
I:1-100 # Preferred format
I(+):90-150 # Strand will be omitted
S288c.I(-):190-200 # Species names will be omitted
MARKDOWN
return $desc;
}
sub validate_args {
my ( $self, $opt, $args ) = @_;
if ( @{$args} < 2 ) {
my $message = "This command need two input files.\n\tIt found";
$message .= sprintf " [%s]", $_ for @{$args};
$message .= ".\n";
$self->usage_error($message);
}
for ( @{$args} ) {
next if lc $_ eq "stdin";
if ( !Path::Tiny::path($_)->is_file ) {
$self->usage_error("The input file [$_] doesn't exist.");
}
}
if ( $opt->{op} =~ /^overlap/i ) {
$opt->{op} = 'overlap';
}
elsif ( $opt->{op} =~ /^non/i ) {
$opt->{op} = 'non-overlap';
}
elsif ( $opt->{op} =~ /^superset/i ) {
$opt->{op} = 'superset';
}
else {
Carp::confess "[@{[$opt->{op}]}] invalid\n";
}
if ( !exists $opt->{outfile} ) {
$opt->{outfile} = Path::Tiny::path( $args->[0] )->absolute . "." . $opt->{op} . ".yml";
}
}
sub execute {
my ( $self, $opt, $args ) = @_;
#----------------------------#
# Loading
#----------------------------#
my $chrs = Set::Scalar->new;
my $set_single
= App::RL::Common::runlist2set( YAML::Syck::LoadFile( $args->[0] ), $opt->{remove} );
$chrs->insert( keys %{$set_single} );
#----------------------------#
# Reading and Output
#----------------------------#
my $in_fh = IO::Zlib->new( $args->[1], "rb" );
my $out_fh;
if ( lc( $opt->{outfile} ) eq "stdout" ) {
$out_fh = *STDOUT;
}
else {
open $out_fh, ">", $opt->{outfile};
}
while ( !$in_fh->eof ) {
my $line = $in_fh->getline;
( run in 0.336 second using v1.01-cache-2.11-cpan-39bf76dae61 )