File Coverage

blib/lib/App/Rangeops/Command/filter.pm
Criterion Covered Total %
statement 59 63 93.6
branch 13 20 65.0
condition n/a
subroutine 11 11 100.0
pod 5 5 100.0
total 88 99 88.8


line stmt bran cond sub pod time code
1             package App::Rangeops::Command::filter;
2 9     9   5144 use strict;
  9         22  
  9         233  
3 9     9   42 use warnings;
  9         22  
  9         203  
4 9     9   48 use autodie;
  9         20  
  9         44  
5              
6 9     9   44136 use App::Rangeops -command;
  9         20  
  9         291  
7 9     9   2666 use App::Rangeops::Common;
  9         22  
  9         220  
8              
9 9         5583 use constant abstract =>
10 9     9   44 'filter links by numbers of ranges or length difference';
  9         18  
11              
12             sub opt_spec {
13             return (
14 3     3 1 17 [ "outfile|o=s", "Output filename. [stdout] for screen." ],
15             [ "number|n=s", "Numbers of ranges, a valid IntSpan runlist.", ],
16             [ "ratio|r=f",
17             "Ratio of lengths differences. The suggested value is [0.8]",
18             ],
19             );
20             }
21              
22             sub usage_desc {
23 3     3 1 29390 return "rangeops filter [options] ";
24             }
25              
26             sub description {
27 1     1 1 833 my $desc;
28 1         3 $desc .= ucfirst(abstract) . ".\n";
29 1         2 $desc .= "\tIt's assumed that all ranges in input files are valid.\n";
30 1         3 return $desc;
31             }
32              
33             sub validate_args {
34 2     2 1 2265 my ( $self, $opt, $args ) = @_;
35              
36 2 50       6 if ( !@{$args} ) {
  2         7  
37 0         0 $self->usage_error("This command need one or more input files.");
38             }
39 2         5 for ( @{$args} ) {
  2         5  
40 2 50       8 next if lc $_ eq "stdin";
41 2 50       10 if ( !Path::Tiny::path($_)->is_file ) {
42 0         0 $self->usage_error("The input file [$_] doesn't exist.");
43             }
44             }
45              
46 2 50       171 if ( !exists $opt->{outfile} ) {
47             $opt->{outfile}
48 0         0 = Path::Tiny::path( $args->[0] )->absolute . ".filter.tsv";
49             }
50             }
51              
52             sub execute {
53 2     2 1 16 my ( $self, $opt, $args ) = @_;
54              
55             #----------------------------#
56             # Loading
57             #----------------------------#
58 2         4 my @lines;
59 2         4 for my $file ( @{$args} ) {
  2         5  
60 2         9 for my $line ( App::RL::Common::read_lines($file) ) {
61 12         2708 my @parts = split /\t/, $line;
62 12 50       34 if ( defined $opt->{number} ) {
63 12         37 my $intspan = AlignDB::IntSpan->new;
64 12         133 $intspan->merge( $opt->{number} );
65              
66 12 100       1955 next unless $intspan->contains( scalar @parts );
67             }
68              
69 6 100       189 if ( defined $opt->{ratio} ) {
70 2         4 my @lengths;
71 2         5 for my $part (@parts) {
72 6         60 my $info = App::RL::Common::decode_header($part);
73 6 50       839 next unless App::RL::Common::info_is_valid($info);
74 6         158 push @lengths, ( $info->{end} - $info->{start} + 1 );
75             }
76 2         29 my ( $l_min, $l_max ) = List::MoreUtils::PP::minmax(@lengths);
77 2         63 my $diff_ratio = sprintf "%.3f", $l_min / $l_max;
78              
79 2 100       11 next if ( $diff_ratio < $opt->{ratio} );
80             }
81              
82 5         13 push @lines, $line; # May produce duplicated lines
83             }
84             }
85 2         39 @lines = List::MoreUtils::PP::uniq(@lines);
86              
87             #----------------------------#
88             # Output
89             #----------------------------#
90 2         33 my $out_fh;
91 2 50       8 if ( lc( $opt->{outfile} ) eq "stdout" ) {
92 2         5 $out_fh = \*STDOUT;
93             }
94             else {
95 0         0 open $out_fh, ">", $opt->{outfile};
96             }
97              
98 2         7 print {$out_fh} "$_\n" for @lines;
  5         51  
99              
100 2         34 close $out_fh;
101             }
102              
103             1;