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   15533 use strict;
  20         56  
  20         621  
3 20     20   113 use warnings;
  20         44  
  20         612  
4 20     20   112 use autodie;
  20         45  
  20         217  
5              
6 20     20   107214 use App::Fasops -command;
  20         50  
  20         194  
7 20     20   6848 use App::Fasops::Common;
  20         60  
  20         23783  
8              
9             sub abstract {
10 2     2 1 65 return 'scan blocked fasta files and output covers on chromosomes';
11             }
12              
13             sub opt_spec {
14             return (
15 5     5 1 51 [ "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 52859 return "fasops covers [options] [more infiles]";
28             }
29              
30             sub description {
31 1     1 1 1244 my $desc;
32 1         6 $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         4 return $desc;
41             }
42              
43             sub validate_args {
44 4     4 1 5448 my ( $self, $opt, $args ) = @_;
45              
46 4 100       10 if ( !@{$args} ) {
  4         18  
47 1         3 my $message = "This command need one or more input files.\n\tIt found";
48 1         3 $message .= sprintf " [%s]", $_ for @{$args};
  1         4  
49 1         3 $message .= ".\n";
50 1         12 $self->usage_error($message);
51             }
52 3         7 for ( @{$args} ) {
  3         10  
53 3 50       14 next if lc $_ eq "stdin";
54 3 100       19 if ( !Path::Tiny::path($_)->is_file ) {
55 1         139 $self->usage_error("The input file [$_] doesn't exist.");
56             }
57             }
58              
59 2 50       208 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 18 my ( $self, $opt, $args ) = @_;
66              
67 2         5 my %count_of; # YAML::Sync can't Dump tied hashes
68 2         6 for my $infile ( @{$args} ) {
  2         6  
69 2         4 my $in_fh;
70 2 50       10 if ( lc $infile eq "stdin" ) {
71 0         0 $in_fh = *STDIN{IO};
72             }
73             else {
74 2         22 $in_fh = IO::Zlib->new( $infile, "rb" );
75             }
76              
77 2         4032 my $content = ''; # content of one block
78 2         6 while (1) {
79 56 100 66     745 last if $in_fh->eof and $content eq '';
80 54         2353 my $line = '';
81 54 50       166 if ( !$in_fh->eof ) {
82 54         2086 $line = $in_fh->getline;
83             }
84 54 50       6279 next if substr( $line, 0, 1 ) eq "#";
85              
86 54 100 66     299 if ( ( $line eq '' or $line =~ /^\s+$/ ) and $content ne '' ) {
      66        
87 6         27 my $info_of = App::Fasops::Common::parse_block($content);
88 6         15 $content = '';
89              
90 6         10 my @names = keys %{$info_of};
  6         27  
91 6 100       165 if ( $opt->{name} ) {
92 3 50       15 if ( exists $info_of->{ $opt->{name} } ) {
93 3         22 @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       18 if length $info_of->{ $names[0] }{seq} < $opt->{length};
104             }
105              
106 5         70 for my $key (@names) {
107 14         860 my $name = $info_of->{$key}{name};
108 14         160 my $chr_name = $info_of->{$key}{chr};
109              
110 14 100       146 if ( !exists $count_of{$name} ) {
111 5         12 $count_of{$name} = {};
112             }
113 14 100       34 if ( !exists $count_of{$name}->{$chr_name} ) {
114 7         30 $count_of{$name}->{$chr_name} = AlignDB::IntSpan->new();
115             }
116              
117             my $intspan = AlignDB::IntSpan->new->add_pair( $info_of->{$key}{start},
118 14         119 $info_of->{$key}{end} );
119 14 100       1270 if ( $opt->{trim} ) {
120 2         9 $intspan = $intspan->trim( $opt->{trim} );
121             }
122              
123 14         238 $count_of{$name}->{$chr_name}->add($intspan);
124             }
125             }
126             else {
127 48         104 $content .= $line;
128             }
129             }
130              
131 2         340 $in_fh->close;
132             }
133              
134             # IntSpan to runlist
135 2         424 for my $name ( keys %count_of ) {
136 5         143 for my $chr_name ( keys %{ $count_of{$name} } ) {
  5         17  
137             $count_of{$name}->{$chr_name}
138 7         85 = $count_of{$name}->{$chr_name}->runlist();
139             }
140             }
141              
142 2         92 my $out_fh;
143 2 50       12 if ( lc( $opt->{outfile} ) eq "stdout" ) {
144 2         8 $out_fh = *STDOUT{IO};
145             }
146             else {
147 0         0 open $out_fh, ">", $opt->{outfile};
148             }
149              
150 2 100       8 if ( defined $opt->{name} ) {
151 1         5 print {$out_fh} YAML::Syck::Dump( $count_of{ $opt->{name} } );
  1         10  
152             }
153             else {
154 1         2 print {$out_fh} YAML::Syck::Dump( \%count_of );
  1         10  
155             }
156 2         279 close $out_fh;
157             }
158              
159             1;