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 14     14   8588 use strict;
  14         34  
  14         370  
3 14     14   66 use warnings;
  14         29  
  14         307  
4 14     14   81 use autodie;
  14         29  
  14         75  
5              
6 14     14   67949 use App::RL -command;
  14         32  
  14         134  
7 14     14   4446 use App::RL::Common;
  14         29  
  14         382  
8              
9 14     14   71 use constant abstract => 'output covers of positions on chromosomes';
  14         27  
  14         8131  
10              
11             sub opt_spec {
12 4     4 1 22 return ( [ "outfile|o=s", "Output filename. [stdout] for screen" ], { show_defaults => 1, } );
13             }
14              
15             sub usage_desc {
16 4     4 1 33823 return "runlist cover [options] ";
17             }
18              
19             sub description {
20 1     1 1 488 my $desc;
21 1         3 $desc .= ucfirst(abstract) . ".\n";
22 1         2 $desc .= " " x 4 . "Like `runlist combine`, but are genome positions.\n";
23 1         3 $desc .= " " x 4 . "I:1-100\n";
24 1         2 $desc .= " " x 4 . "I(+):90-150\n";
25 1         3 $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 1657 my ( $self, $opt, $args ) = @_;
31              
32 3 100       6 if ( !@{$args} ) {
  3         11  
33 1         3 my $message = "This command need one or more input files.\n\tIt found";
34 1         2 $message .= sprintf " [%s]", $_ for @{$args};
  1         3  
35 1         3 $message .= ".\n";
36 1         7 $self->usage_error($message);
37             }
38 2         4 for ( @{$args} ) {
  2         5  
39 2 50       8 next if lc $_ eq "stdin";
40 2 100       9 if ( !Path::Tiny::path($_)->is_file ) {
41 1         107 $self->usage_error("The input file [$_] doesn't exist.");
42             }
43             }
44              
45 1 50       61 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         2 my %count_of; # YAML::Sync can't Dump tied hashes
54 1         2 for my $infile ( @{$args} ) {
  1         3  
55 1         7 for my $line ( App::RL::Common::read_lines($infile) ) {
56 5 50       343 next if substr( $line, 0, 1 ) eq "#";
57              
58 5         14 my $info = App::RL::Common::decode_header($line);
59 5 50       12 next unless App::RL::Common::info_is_valid($info);
60              
61 5         16 my $chr_name = $info->{chr};
62 5 100       31 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       4 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         6  
86 1         131 close $out_fh;
87             }
88              
89             1;