File Coverage

blib/lib/App/Fasops/Command/axt2fas.pm
Criterion Covered Total %
statement 86 88 97.7
branch 32 38 84.2
condition 8 9 88.8
subroutine 12 12 100.0
pod 6 6 100.0
total 144 153 94.1


line stmt bran cond sub pod time code
1             package App::Fasops::Command::axt2fas;
2 21     21   424108 use strict;
  21         56  
  21         741  
3 21     21   115 use warnings;
  21         69  
  21         632  
4 21     21   9295 use autodie;
  21         297385  
  21         124  
5              
6 21     21   138236 use App::Fasops -command;
  21         59  
  21         324  
7 21     21   19941 use App::RL::Common;
  21         2142663  
  21         894  
8 21     21   12724 use App::Fasops::Common;
  21         77  
  21         23049  
9              
10             sub abstract {
11 2     2 1 34734 return 'convert axt to blocked fasta';
12             }
13              
14             sub opt_spec {
15             return (
16 9     9 1 102 [ "outfile|o=s", "Output filename, [stdout] for screen" ],
17             [ "length|l=i", "the threshold of alignment length", { default => 1 }, ],
18             [ "tname|t=s", "target name", { default => "target" }, ],
19             [ "qname|q=s", "query name", { default => "query" }, ],
20             [ "size|s=s", "query chr.sizes", ],
21             { show_defaults => 1, }
22             );
23             }
24              
25             sub usage_desc {
26 9     9 1 70251 return "fasops axt2fas [options] [more infiles]";
27             }
28              
29             sub description {
30 1     1 1 1422 my $desc;
31 1         5 $desc .= ucfirst(abstract) . ".\n";
32 1         4 $desc .= <<'MARKDOWN';
33              
34             * are paths to axt files, .axt.gz is supported
35             * infile == stdin means reading from STDIN
36             * Without query chr.sizes file, positions on negative strand of query will be wrong
37              
38             MARKDOWN
39              
40 1         3 return $desc;
41             }
42              
43             sub validate_args {
44 8     8 1 12697 my ( $self, $opt, $args ) = @_;
45              
46 8 100       14 if ( !@{$args} ) {
  8         25  
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         5  
49 1         5 $message .= ".\n";
50 1         10 $self->usage_error($message);
51             }
52 7         14 for ( @{$args} ) {
  7         16  
53 7 50       24 next if lc $_ eq "stdin";
54 7 100       30 if ( !Path::Tiny::path($_)->is_file ) {
55 1         118 $self->usage_error("The input file [$_] doesn't exist.");
56             }
57             }
58              
59 6 100       394 if ( !exists $opt->{outfile} ) {
60 3         11 $opt->{outfile} = Path::Tiny::path( $args->[0] )->absolute . ".fas";
61             }
62              
63 6 50       373 if ( $opt->{tname} ) {
64 6 100       37 if ( $opt->{tname} !~ /^[\w]+$/ ) {
65 1         6 $self->usage_error("[--tname] should be an alphanumeric value.");
66             }
67             }
68 5 50       16 if ( $opt->{qname} ) {
69 5 100       24 if ( $opt->{qname} !~ /^[\w]+$/ ) {
70 1         5 $self->usage_error("[--qname] should be an alphanumeric value.");
71             }
72             }
73              
74 4 100       17 if ( $opt->{size} ) {
75 2 100       9 if ( !Path::Tiny::path( $opt->{size} )->is_file ) {
76 1         74 $self->usage_error("The size file [$opt->{size}] doesn't exist.");
77             }
78             }
79             }
80              
81             sub execute {
82 3     3 1 67 my ( $self, $opt, $args ) = @_;
83              
84 3         7 my $out_fh;
85 3 50       11 if ( lc( $opt->{outfile} ) eq "stdout" ) {
86 3         9 $out_fh = *STDOUT{IO};
87             }
88             else {
89 0         0 open $out_fh, ">", $opt->{outfile};
90             }
91              
92 3         8 my $length_of;
93 3 100       9 if ( $opt->{size} ) {
94 1         7 $length_of = App::RL::Common::read_sizes( $opt->{size} );
95             }
96              
97 3         5001 for my $infile ( @{$args} ) {
  3         9  
98 3         5 my $in_fh;
99 3 50       11 if ( lc $infile eq "stdin" ) {
100 0         0 $in_fh = *STDIN{IO};
101             }
102             else {
103 3         22 $in_fh = IO::Zlib->new( $infile, "rb" );
104             }
105              
106 3         4954 my $content = ''; # content of one block
107 3         8 while (1) {
108 48 100 100     269 last if $in_fh->eof and $content eq '';
109 45         2356 my $line = '';
110 45 100       148 if ( !$in_fh->eof ) {
111 42         1644 $line = $in_fh->getline;
112             }
113              
114 45 100 100     5735 if ( substr( $line, 0, 1 ) eq "#" ) {
    100 66        
115 21         40 next;
116             }
117             elsif ( ( $line eq '' or $line =~ /^\s+$/ ) and $content ne '' ) {
118 6         25 my $info_refs = App::Fasops::Common::parse_axt_block( $content, $length_of );
119 6         14 $content = '';
120              
121             next
122 6 100       36 if App::Fasops::Common::seq_length( $info_refs->[0]{seq} ) < $opt->{length};
123             next
124 5 50       17 if App::Fasops::Common::seq_length( $info_refs->[1]{seq} ) < $opt->{length};
125              
126 5         12 $info_refs->[0]{name} = $opt->{tname};
127 5         11 $info_refs->[1]{name} = $opt->{qname};
128              
129 5         21 for my $i ( 0, 1 ) {
130 10         160 my $info = $info_refs->[$i];
131 10         16 printf {$out_fh} ">%s\n", App::RL::Common::encode_header($info);
  10         48  
132 10         816 printf {$out_fh} "%s\n", $info->{seq};
  10         41  
133             }
134 5         90 print {$out_fh} "\n";
  5         17  
135             }
136             else {
137 18         55 $content .= $line;
138             }
139             }
140              
141 3         495 $in_fh->close;
142             }
143              
144 3         488 close $out_fh;
145             }
146              
147             1;