File Coverage

blib/lib/App/Fasops/Command/split.pm
Criterion Covered Total %
statement 85 94 90.4
branch 23 30 76.6
condition 6 9 66.6
subroutine 12 12 100.0
pod 6 6 100.0
total 132 151 87.4


line stmt bran cond sub pod time code
1             package App::Fasops::Command::split;
2 21     21   15517 use strict;
  21         54  
  21         662  
3 21     21   117 use warnings;
  21         51  
  21         541  
4 21     21   104 use autodie;
  21         62  
  21         145  
5              
6 21     21   107169 use App::Fasops -command;
  21         52  
  21         239  
7 21     21   7464 use App::RL::Common;
  21         54  
  21         624  
8 21     21   122 use App::Fasops::Common;
  21         47  
  21         24508  
9              
10             sub abstract {
11 2     2 1 49 return 'split blocked fasta files to per-alignment files';
12             }
13              
14             sub opt_spec {
15             return (
16 6     6 1 40 [ "outdir|o=s", "Output location, [stdout] for screen" ],
17             [ "rm|r", "if outdir exists, remove it before operating." ],
18             [ "chr", "split by chromosomes." ],
19             [ "simple", "only keep names in headers" ],
20             { show_defaults => 1, }
21             );
22             }
23              
24             sub usage_desc {
25 6     6 1 54273 return "fasops split [options] [more infiles]";
26             }
27              
28             sub description {
29 1     1 1 1082 my $desc;
30 1         6 $desc .= ucfirst(abstract) . ".\n";
31 1         4 $desc .= <<'MARKDOWN';
32              
33             * are paths to blocked fasta files, .fas.gz is supported
34             * infile == stdin means reading from STDIN
35              
36             MARKDOWN
37              
38 1         4 return $desc;
39             }
40              
41             sub validate_args {
42 5     5 1 6008 my ( $self, $opt, $args ) = @_;
43              
44 5 100       10 if ( !@{$args} ) {
  5         19  
45 1         3 my $message = "This command need one or more input files.\n\tIt found";
46 1         2 $message .= sprintf " [%s]", $_ for @{$args};
  1         3  
47 1         4 $message .= ".\n";
48 1         9 $self->usage_error($message);
49             }
50 4         9 for ( @{$args} ) {
  4         9  
51 4 50       14 next if lc $_ eq "stdin";
52 4 100       18 if ( !Path::Tiny::path($_)->is_file ) {
53 1         119 $self->usage_error("The input file [$_] doesn't exist.");
54             }
55             }
56              
57 3 50       196 if ( !exists $opt->{outdir} ) {
58 0         0 $opt->{outdir} = Path::Tiny::path( $args->[0] )->absolute . ".split";
59             }
60 3 100       33 if ( -e $opt->{outdir} ) {
61 1 50       7 if ( $opt->{rm} ) {
62 0         0 Path::Tiny::path( $opt->{outdir} )->remove_tree;
63             }
64             }
65              
66 3 100       19 if ( lc( $opt->{outdir} ) ne "stdout" ) {
67 1         5 Path::Tiny::path( $opt->{outdir} )->mkpath;
68             }
69             }
70              
71             sub execute {
72 3     3 1 147 my ( $self, $opt, $args ) = @_;
73              
74 3         8 for my $infile ( @{$args} ) {
  3         7  
75 3         4 my $in_fh;
76 3 50       11 if ( lc $infile eq "stdin" ) {
77 0         0 $in_fh = *STDIN{IO};
78             }
79             else {
80 3         24 $in_fh = IO::Zlib->new( $infile, "rb" );
81             }
82              
83 3         4930 my $content = ''; # content of one block
84 3         5 while (1) {
85 84 100 66     1729 last if $in_fh->eof and $content eq '';
86 81         3471 my $line = '';
87 81 50       245 if ( !$in_fh->eof ) {
88 81         3128 $line = $in_fh->getline;
89             }
90 81 100 66     9513 if ( ( $line eq '' or $line =~ /^\s+$/ ) and $content ne '' ) {
      66        
91 9         32 my $info_of = App::Fasops::Common::parse_block($content);
92 9         17 $content = '';
93              
94 9 100       42 if ( lc( $opt->{outdir} ) eq "stdout" ) {
95 6         10 for my $key ( keys %{$info_of} ) {
  6         22  
96 24 100       566 if ( $opt->{simple} ) {
97 12         35 printf ">%s\n", $info_of->{$key}{name};
98             }
99             else {
100 12         39 printf ">%s\n", App::RL::Common::encode_header( $info_of->{$key} );
101             }
102 24         2530 print $info_of->{$key}{seq} . "\n";
103             }
104             }
105             else {
106 3         7 my $target = ( keys %{$info_of} )[0];
  3         11  
107 3         90 my $filename;
108 3 50       8 if ( $opt->{chr} ) {
109 3         10 $filename = $info_of->{$target}{chr};
110 3         36 $filename .= '.fas';
111             }
112             else {
113 0         0 $filename = App::RL::Common::encode_header( $info_of->{$target} );
114 0         0 $filename =~ s/\|.+//; # remove addtional fields
115 0         0 $filename =~ s/[\(\)\:]+/./g;
116 0         0 $filename .= '.fas';
117             }
118 3         12 $filename = Path::Tiny::path( $opt->{outdir}, $filename );
119              
120 3         125 open my $out_fh, ">>", $filename;
121 3         2497 for my $key ( keys %{$info_of} ) {
  3         17  
122 12 50       192 if ( $opt->{simple} ) {
123 0         0 printf {$out_fh} ">%s\n", $info_of->{$key}{name};
  0         0  
124             }
125             else {
126 12         39 printf {$out_fh} ">%s\n",
127 12         21 App::RL::Common::encode_header( $info_of->{$key} );
128             }
129 12         1918 print {$out_fh} $info_of->{$key}{seq} . "\n";
  12         44  
130             }
131 3         37 print {$out_fh} "\n";
  3         9  
132 3         13 close $out_fh;
133             }
134             }
135             else {
136 72         150 $content .= $line;
137             }
138             }
139              
140 3         551 $in_fh->close;
141             }
142             }
143              
144             1;