File Coverage

blib/lib/App/RL/Command/cover.pm
Criterion Covered Total %
statement 61 63 96.8
branch 11 16 68.7
condition n/a
subroutine 11 11 100.0
pod 5 5 100.0
total 88 95 92.6


line stmt bran cond sub pod time code
1             package App::RL::Command::cover;
2 13     13   9948 use strict;
  13         34  
  13         379  
3 13     13   64 use warnings;
  13         31  
  13         361  
4 13     13   61 use autodie;
  13         29  
  13         82  
5              
6 13     13   69787 use App::RL -command;
  13         36  
  13         162  
7 13     13   4938 use App::RL::Common;
  13         30  
  13         439  
8              
9 13     13   72 use constant abstract => 'output covers of positions on chromosomes';
  13         35  
  13         8857  
10              
11             sub opt_spec {
12 4     4 1 20 return ( [ "outfile|o=s", "Output filename. [stdout] for screen" ], { show_defaults => 1, } );
13             }
14              
15             sub usage_desc {
16 4     4 1 32549 return "runlist cover [options] ";
17             }
18              
19             sub description {
20 1     1 1 496 my $desc;
21 1         2 $desc .= ucfirst(abstract) . ".\n";
22 1         3 $desc .= " " x 4 . "Like `runlist combine`, but are genome positions.\n";
23 1         2 $desc .= " " x 4 . "I:1-100\n";
24 1         3 $desc .= " " x 4 . "I(+):90-150\n";
25 1         2 $desc .= " " x 4 . "S288c.I(-):190-200\tSpecies names will be omitted.\n";
26 1         3 return $desc;
27             }
28              
29             sub validate_args {
30 3     3 1 1945 my ( $self, $opt, $args ) = @_;
31              
32 3 100       5 if ( !@{$args} ) {
  3         10  
33 1         2 my $message = "This command need one or more input files.\n\tIt found";
34 1         3 $message .= sprintf " [%s]", $_ for @{$args};
  1         3  
35 1         3 $message .= ".\n";
36 1         8 $self->usage_error($message);
37             }
38 2         4 for ( @{$args} ) {
  2         4  
39 2 50       8 next if lc $_ eq "stdin";
40 2 100       9 if ( !Path::Tiny::path($_)->is_file ) {
41 1         98 $self->usage_error("The input file [$_] doesn't exist.");
42             }
43             }
44              
45 1 50       60 if ( !exists $opt->{outfile} ) {
46 0         0 $opt->{outfile} = Path::Tiny::path( $args->[0] )->absolute . ".yml";
47             }
48             }
49              
50             sub execute {
51 1     1 1 6 my ( $self, $opt, $args ) = @_;
52              
53 1         3 my %count_of; # YAML::Sync can't Dump tied hashes
54 1         2 for my $infile ( @{$args} ) {
  1         3  
55 1         6 for my $line ( App::RL::Common::read_lines($infile) ) {
56 5 50       381 next if substr( $line, 0, 1 ) eq "#";
57              
58 5         14 my $info = App::RL::Common::decode_header($line);
59 5 50       13 next unless App::RL::Common::info_is_valid($info);
60              
61 5         16 my $chr_name = $info->{chr};
62 5 100       33 if ( !exists $count_of{$chr_name} ) {
63 2         7 $count_of{$chr_name} = App::RL::Common::new_set();
64             }
65 5         39 $count_of{$chr_name}->add_pair( $info->{start}, $info->{end} );
66             }
67             }
68              
69             # IntSpan to runlist
70 1         71 for my $chr_name ( keys %count_of ) {
71 2         54 $count_of{$chr_name} = $count_of{$chr_name}->runlist;
72             }
73              
74             #----------------------------#
75             # Output
76             #----------------------------#
77 1         38 my $out_fh;
78 1 50       5 if ( lc( $opt->{outfile} ) eq "stdout" ) {
79 1         4 $out_fh = *STDOUT;
80             }
81             else {
82 0         0 open $out_fh, ">", $opt->{outfile};
83             }
84              
85 1         2 print {$out_fh} YAML::Syck::Dump( \%count_of );
  1         7  
86 1         138 close $out_fh;
87             }
88              
89             1;