File Coverage

blib/lib/App/RL/Command/cover.pm
Criterion Covered Total %
statement 56 58 96.5
branch 11 16 68.7
condition n/a
subroutine 11 11 100.0
pod 6 6 100.0
total 84 91 92.3


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