File Coverage

blib/lib/App/Rangeops/Command/filter.pm
Criterion Covered Total %
statement 57 61 93.4
branch 13 20 65.0
condition n/a
subroutine 11 11 100.0
pod 6 6 100.0
total 87 98 88.7


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