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   6244 use strict;
  9         15  
  9         298  
3 9     9   40 use warnings;
  9         15  
  9         251  
4 9     9   41 use autodie;
  9         14  
  9         49  
5              
6 9     9   35946 use App::Rangeops -command;
  9         13  
  9         107  
7 9     9   2605 use App::Rangeops::Common;
  9         18  
  9         268  
8              
9 9         7102 use constant abstract =>
10 9     9   46 '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 34171 return "rangeops filter [options] ";
24             }
25              
26             sub description {
27 1     1 1 691 my $desc;
28 1         2 $desc .= ucfirst(abstract) . ".\n";
29 1         2 $desc .= "\tIt's assumed that all ranges in input files are valid.\n";
30 1         2 return $desc;
31             }
32              
33             sub validate_args {
34 2     2 1 1889 my ( $self, $opt, $args ) = @_;
35              
36 2 50       3 if ( !@{$args} ) {
  2         8  
37 0         0 $self->usage_error("This command need one or more input files.");
38             }
39 2         4 for ( @{$args} ) {
  2         6  
40 2 50       6 next if lc $_ eq "stdin";
41 2 50       15 if ( !Path::Tiny::path($_)->is_file ) {
42 0         0 $self->usage_error("The input file [$_] doesn't exist.");
43             }
44             }
45              
46 2 50       168 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 8 my ( $self, $opt, $args ) = @_;
54              
55             #----------------------------#
56             # Loading
57             #----------------------------#
58 2         3 my @lines;
59 2         3 for my $file ( @{$args} ) {
  2         4  
60 2         10 for my $line ( App::RL::Common::read_lines($file) ) {
61 12         487 my @parts = split /\t/, $line;
62 12 50       28 if ( defined $opt->{number} ) {
63 12         38 my $intspan = AlignDB::IntSpan->new;
64 12         92 $intspan->merge( $opt->{number} );
65              
66 12 100       1072 next unless $intspan->contains( scalar @parts );
67             }
68              
69 6 100       112 if ( defined $opt->{ratio} ) {
70 2         3 my @lengths;
71 2         3 for my $part (@parts) {
72 6         56 my $info = App::RL::Common::decode_header($part);
73 6 50       573 next unless App::RL::Common::info_is_valid($info);
74 6         138 push @lengths, ( $info->{end} - $info->{start} + 1 );
75             }
76 2         26 my ( $l_min, $l_max ) = List::MoreUtils::PP::minmax(@lengths);
77 2         51 my $diff_ratio = sprintf "%.3f", $l_min / $l_max;
78              
79 2 100       13 next if ( $diff_ratio < $opt->{ratio} );
80             }
81              
82 5         12 push @lines, $line; # May produce duplicated lines
83             }
84             }
85 2         29 @lines = List::MoreUtils::PP::uniq(@lines);
86              
87             #----------------------------#
88             # Output
89             #----------------------------#
90 2         26 my $out_fh;
91 2 50       8 if ( lc( $opt->{outfile} ) eq "stdout" ) {
92 2         4 $out_fh = \*STDOUT;
93             }
94             else {
95 0         0 open $out_fh, ">", $opt->{outfile};
96             }
97              
98 2         5 print {$out_fh} "$_\n" for @lines;
  5         39  
99              
100 2         27 close $out_fh;
101             }
102              
103             1;