File Coverage

blib/lib/App/Fasops/Command/covers.pm
Criterion Covered Total %
statement 86 91 94.5
branch 28 36 77.7
condition 6 9 66.6
subroutine 11 11 100.0
pod 6 6 100.0
total 137 153 89.5


line stmt bran cond sub pod time code
1             package App::Fasops::Command::covers;
2 20     20   15429 use strict;
  20         51  
  20         618  
3 20     20   110 use warnings;
  20         43  
  20         624  
4 20     20   110 use autodie;
  20         46  
  20         173  
5              
6 20     20   106443 use App::Fasops -command;
  20         57  
  20         213  
7 20     20   7300 use App::Fasops::Common;
  20         49  
  20         23476  
8              
9             sub abstract {
10 2     2 1 50 return 'scan blocked fasta files and output covers on chromosomes';
11             }
12              
13             sub opt_spec {
14             return (
15 5     5 1 47 [ "outfile|o=s", "Output filename. [stdout] for screen" ],
16             [ "name|n=s", "Only output this species" ],
17             [ "length|l=i", "the threshold of alignment length", { default => 1 } ],
18             [ "trim|t=i",
19             "Trim align borders to avoid some overlaps in lastz results",
20             { default => 0 }
21             ],
22             { show_defaults => 1, }
23             );
24             }
25              
26             sub usage_desc {
27 5     5 1 51526 return "fasops covers [options] [more infiles]";
28             }
29              
30             sub description {
31 1     1 1 1147 my $desc;
32 1         5 $desc .= ucfirst(abstract) . ".\n";
33 1         3 $desc .= <<'MARKDOWN';
34              
35             * are paths to axt files, .axt.gz is supported
36             * infile == stdin means reading from STDIN
37              
38             MARKDOWN
39              
40 1         3 return $desc;
41             }
42              
43             sub validate_args {
44 4     4 1 5529 my ( $self, $opt, $args ) = @_;
45              
46 4 100       9 if ( !@{$args} ) {
  4         15  
47 1         3 my $message = "This command need one or more input files.\n\tIt found";
48 1         2 $message .= sprintf " [%s]", $_ for @{$args};
  1         4  
49 1         3 $message .= ".\n";
50 1         11 $self->usage_error($message);
51             }
52 3         5 for ( @{$args} ) {
  3         9  
53 3 50       9 next if lc $_ eq "stdin";
54 3 100       14 if ( !Path::Tiny::path($_)->is_file ) {
55 1         122 $self->usage_error("The input file [$_] doesn't exist.");
56             }
57             }
58              
59 2 50       137 if ( !exists $opt->{outfile} ) {
60 0         0 $opt->{outfile} = Path::Tiny::path( $args->[0] )->absolute . ".yml";
61             }
62             }
63              
64             sub execute {
65 2     2 1 14 my ( $self, $opt, $args ) = @_;
66              
67 2         4 my %count_of; # YAML::Sync can't Dump tied hashes
68 2         5 for my $infile ( @{$args} ) {
  2         5  
69 2         4 my $in_fh;
70 2 50       9 if ( lc $infile eq "stdin" ) {
71 0         0 $in_fh = *STDIN{IO};
72             }
73             else {
74 2         14 $in_fh = IO::Zlib->new( $infile, "rb" );
75             }
76              
77 2         3481 my $content = ''; # content of one block
78 2         5 while (1) {
79 56 100 66     742 last if $in_fh->eof and $content eq '';
80 54         2329 my $line = '';
81 54 50       184 if ( !$in_fh->eof ) {
82 54         2087 $line = $in_fh->getline;
83             }
84 54 50       6267 next if substr( $line, 0, 1 ) eq "#";
85              
86 54 100 66     301 if ( ( $line eq '' or $line =~ /^\s+$/ ) and $content ne '' ) {
      66        
87 6         24 my $info_of = App::Fasops::Common::parse_block($content);
88 6         12 $content = '';
89              
90 6         11 my @names = keys %{$info_of};
  6         21  
91 6 100       178 if ( $opt->{name} ) {
92 3 50       15 if ( exists $info_of->{ $opt->{name} } ) {
93 3         21 @names = ( $opt->{name} );
94             }
95             else {
96 0         0 warn "$opt->{name} doesn't exist in this alignment\n";
97 0         0 next;
98             }
99             }
100              
101 6 50       17 if ( $opt->{length} ) {
102             next
103 6 100       22 if length $info_of->{ $names[0] }{seq} < $opt->{length};
104             }
105              
106 5         64 for my $key (@names) {
107 14         864 my $name = $info_of->{$key}{name};
108 14         157 my $chr_name = $info_of->{$key}{chr};
109              
110 14 100       146 if ( !exists $count_of{$name} ) {
111 5         17 $count_of{$name} = {};
112             }
113 14 100       30 if ( !exists $count_of{$name}->{$chr_name} ) {
114 7         24 $count_of{$name}->{$chr_name} = AlignDB::IntSpan->new();
115             }
116              
117             my $intspan = AlignDB::IntSpan->new->add_pair( $info_of->{$key}{start},
118 14         103 $info_of->{$key}{end} );
119 14 100       1258 if ( $opt->{trim} ) {
120 2         9 $intspan = $intspan->trim( $opt->{trim} );
121             }
122              
123 14         234 $count_of{$name}->{$chr_name}->add($intspan);
124             }
125             }
126             else {
127 48         93 $content .= $line;
128             }
129             }
130              
131 2         333 $in_fh->close;
132             }
133              
134             # IntSpan to runlist
135 2         327 for my $name ( keys %count_of ) {
136 5         143 for my $chr_name ( keys %{ $count_of{$name} } ) {
  5         14  
137             $count_of{$name}->{$chr_name}
138 7         85 = $count_of{$name}->{$chr_name}->runlist();
139             }
140             }
141              
142 2         84 my $out_fh;
143 2 50       9 if ( lc( $opt->{outfile} ) eq "stdout" ) {
144 2         5 $out_fh = *STDOUT{IO};
145             }
146             else {
147 0         0 open $out_fh, ">", $opt->{outfile};
148             }
149              
150 2 100       6 if ( defined $opt->{name} ) {
151 1         4 print {$out_fh} YAML::Syck::Dump( $count_of{ $opt->{name} } );
  1         6  
152             }
153             else {
154 1         2 print {$out_fh} YAML::Syck::Dump( \%count_of );
  1         8  
155             }
156 2         222 close $out_fh;
157             }
158              
159             1;