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   13882 use strict;
  20         47  
  20         631  
3 20     20   105 use warnings;
  20         43  
  20         504  
4 20     20   111 use autodie;
  20         42  
  20         106  
5              
6 20     20   106411 use App::Fasops -command;
  20         51  
  20         266  
7 20     20   6879 use App::RL::Common;
  20         57  
  20         580  
8 20     20   125 use App::Fasops::Common;
  20         44  
  20         18224  
9              
10             sub abstract {
11 2     2 1 47 return 'convert maf to blocked fasta';
12             }
13              
14             sub opt_spec {
15             return (
16 5     5 1 30 [ "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 50053 return "fasops maf2fas [options] [more infiles]";
24             }
25              
26             sub description {
27 1     1 1 843 my $desc;
28 1         5 $desc .= ucfirst(abstract) . ".\n";
29 1         5 $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 3628 my ( $self, $opt, $args ) = @_;
41              
42 4 100       9 if ( !@{$args} ) {
  4         15  
43 1         3 my $message = "This command need one or more input files.\n\tIt found";
44 1         2 $message .= sprintf " [%s]", $_ for @{$args};
  1         3  
45 1         4 $message .= ".\n";
46 1         25 $self->usage_error($message);
47             }
48 3         6 for ( @{$args} ) {
  3         9  
49 3 50       13 next if lc $_ eq "stdin";
50 3 100       15 if ( !Path::Tiny::path($_)->is_file ) {
51 1         110 $self->usage_error("The input file [$_] doesn't exist.");
52             }
53             }
54              
55 2 50       146 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 14 my ( $self, $opt, $args ) = @_;
62              
63 2         4 my $out_fh;
64 2 50       7 if ( lc( $opt->{outfile} ) eq "stdout" ) {
65 2         8 $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         4  
72 2         5 my $in_fh;
73 2 50       5 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         3453 my $content = ''; # content of one block
81 2         5 while (1) {
82 32 100 100     196 last if $in_fh->eof and $content eq '';
83 30         1542 my $line = '';
84 30 100       100 if ( !$in_fh->eof ) {
85 28         1104 $line = $in_fh->getline;
86             }
87              
88 30 100 100     3880 if ( ( $line eq '' or $line =~ /^\s+$/ ) and $content ne '' ) {
    100 66        
89 4         18 my $info_of = App::Fasops::Common::parse_maf_block($content);
90 4         9 $content = '';
91              
92 4         7 my @names = keys %{$info_of};
  4         16  
93 4 100       129 next if length $info_of->{ $names[0] }{seq} < $opt->{length};
94              
95 3         28 for my $key (@names) {
96 12         192 my $info = $info_of->{$key};
97 12         85 printf {$out_fh} ">%s\n", App::RL::Common::encode_header($info);
  12         44  
98 12         893 printf {$out_fh} "%s\n", $info->{seq};
  12         42  
99             }
100 3         53 print {$out_fh} "\n";
  3         11  
101             }
102             elsif ( substr( $line, 0, 2 ) eq "s " ) { # s line, contain info and seq
103 16         56 $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         21 next;
110             }
111             }
112              
113 2         327 $in_fh->close;
114             }
115              
116 2         323 close $out_fh;
117             }
118              
119             1;