File Coverage

blib/lib/App/Fasops/Command/maf2fas.pm
Criterion Covered Total %
statement 72 75 96.0
branch 18 22 81.8
condition 8 9 88.8
subroutine 12 12 100.0
pod 6 6 100.0
total 116 124 93.5


line stmt bran cond sub pod time code
1             package App::Fasops::Command::maf2fas;
2 20     20   14376 use strict;
  20         77  
  20         628  
3 20     20   109 use warnings;
  20         39  
  20         508  
4 20     20   99 use autodie;
  20         44  
  20         166  
5              
6 20     20   106410 use App::Fasops -command;
  20         47  
  20         213  
7 20     20   7068 use App::RL::Common;
  20         49  
  20         542  
8 20     20   114 use App::Fasops::Common;
  20         47  
  20         18387  
9              
10             sub abstract {
11 2     2 1 49 return 'convert maf to blocked fasta';
12             }
13              
14             sub opt_spec {
15             return (
16 5     5 1 35 [ "outfile|o=s", "Output filename. [stdout] for screen" ],
17             [ "length|l=i", "the threshold of alignment length", { default => 1 } ],
18             { show_defaults => 1, }
19             );
20             }
21              
22             sub usage_desc {
23 5     5 1 49377 return "fasops maf2fas [options] [more infiles]";
24             }
25              
26             sub description {
27 1     1 1 776 my $desc;
28 1         4 $desc .= ucfirst(abstract) . ".\n";
29 1         3 $desc .= <<'MARKDOWN';
30              
31             * are paths to maf files, .maf.gz is supported
32             * infile == stdin means reading from STDIN
33              
34             MARKDOWN
35              
36 1         3 return $desc;
37             }
38              
39             sub validate_args {
40 4     4 1 3685 my ( $self, $opt, $args ) = @_;
41              
42 4 100       9 if ( !@{$args} ) {
  4         14  
43 1         3 my $message = "This command need one or more input files.\n\tIt found";
44 1         1 $message .= sprintf " [%s]", $_ for @{$args};
  1         13  
45 1         5 $message .= ".\n";
46 1         13 $self->usage_error($message);
47             }
48 3         7 for ( @{$args} ) {
  3         8  
49 3 50       10 next if lc $_ eq "stdin";
50 3 100       13 if ( !Path::Tiny::path($_)->is_file ) {
51 1         106 $self->usage_error("The input file [$_] doesn't exist.");
52             }
53             }
54              
55 2 50       129 if ( !exists $opt->{outfile} ) {
56 0         0 $opt->{outfile} = Path::Tiny::path( $args->[0] )->absolute . ".fas";
57             }
58             }
59              
60             sub execute {
61 2     2 1 13 my ( $self, $opt, $args ) = @_;
62              
63 2         3 my $out_fh;
64 2 50       8 if ( lc( $opt->{outfile} ) eq "stdout" ) {
65 2         7 $out_fh = *STDOUT{IO};
66             }
67             else {
68 0         0 open $out_fh, ">", $opt->{outfile};
69             }
70              
71 2         4 for my $infile ( @{$args} ) {
  2         5  
72 2         4 my $in_fh;
73 2 50       7 if ( lc $infile eq "stdin" ) {
74 0         0 $in_fh = *STDIN{IO};
75             }
76             else {
77 2         15 $in_fh = IO::Zlib->new( $infile, "rb" );
78             }
79              
80 2         3351 my $content = ''; # content of one block
81 2         5 while (1) {
82 32 100 100     222 last if $in_fh->eof and $content eq '';
83 30         1628 my $line = '';
84 30 100       105 if ( !$in_fh->eof ) {
85 28         1131 $line = $in_fh->getline;
86             }
87              
88 30 100 100     4288 if ( ( $line eq '' or $line =~ /^\s+$/ ) and $content ne '' ) {
    100 66        
89 4         16 my $info_of = App::Fasops::Common::parse_maf_block($content);
90 4         8 $content = '';
91              
92 4         7 my @names = keys %{$info_of};
  4         16  
93 4 100       124 next if length $info_of->{ $names[0] }{seq} < $opt->{length};
94              
95 3         31 for my $key (@names) {
96 12         183 my $info = $info_of->{$key};
97 12         75 printf {$out_fh} ">%s\n", App::RL::Common::encode_header($info);
  12         42  
98 12         872 printf {$out_fh} "%s\n", $info->{seq};
  12         44  
99             }
100 3         68 print {$out_fh} "\n";
  3         9  
101             }
102             elsif ( substr( $line, 0, 2 ) eq "s " ) { # s line, contain info and seq
103 16         36 $content .= $line;
104             }
105             else {
106             # omit # lines
107             # omit a, i, e, q lines
108             # see http://genome.ucsc.edu/FAQ/FAQformat.html#format5
109 10         20 next;
110             }
111             }
112              
113 2         331 $in_fh->close;
114             }
115              
116 2         312 close $out_fh;
117             }
118              
119             1;