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 20     20   13501 use strict;
  20         45  
  20         616  
3 20     20   136 use warnings;
  20         50  
  20         483  
4 20     20   107 use autodie;
  20         44  
  20         116  
5              
6 20     20   105522 use App::Fasops -command;
  20         68  
  20         232  
7 20     20   6732 use App::RL::Common;
  20         47  
  20         580  
8 20     20   119 use App::Fasops::Common;
  20         42  
  20         23520  
9              
10             sub abstract {
11 2     2 1 50 return 'split blocked fasta files to per-alignment files';
12             }
13              
14             sub opt_spec {
15             return (
16 6     6 1 46 [ "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 56587 return "fasops split [options] [more infiles]";
26             }
27              
28             sub description {
29 1     1 1 1097 my $desc;
30 1         5 $desc .= ucfirst(abstract) . ".\n";
31 1         12 $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         5 return $desc;
39             }
40              
41             sub validate_args {
42 5     5 1 6130 my ( $self, $opt, $args ) = @_;
43              
44 5 100       10 if ( !@{$args} ) {
  5         22  
45 1         4 my $message = "This command need one or more input files.\n\tIt found";
46 1         3 $message .= sprintf " [%s]", $_ for @{$args};
  1         3  
47 1         5 $message .= ".\n";
48 1         11 $self->usage_error($message);
49             }
50 4         11 for ( @{$args} ) {
  4         12  
51 4 50       21 next if lc $_ eq "stdin";
52 4 100       26 if ( !Path::Tiny::path($_)->is_file ) {
53 1         138 $self->usage_error("The input file [$_] doesn't exist.");
54             }
55             }
56              
57 3 50       272 if ( !exists $opt->{outdir} ) {
58 0         0 $opt->{outdir} = Path::Tiny::path( $args->[0] )->absolute . ".split";
59             }
60 3 100       35 if ( -e $opt->{outdir} ) {
61 1 50       8 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 156 my ( $self, $opt, $args ) = @_;
73              
74 3         8 for my $infile ( @{$args} ) {
  3         11  
75 3         5 my $in_fh;
76 3 50       13 if ( lc $infile eq "stdin" ) {
77 0         0 $in_fh = *STDIN{IO};
78             }
79             else {
80 3         30 $in_fh = IO::Zlib->new( $infile, "rb" );
81             }
82              
83 3         5710 my $content = ''; # content of one block
84 3         6 while (1) {
85 84 100 66     1665 last if $in_fh->eof and $content eq '';
86 81         3524 my $line = '';
87 81 50       254 if ( !$in_fh->eof ) {
88 81         3253 $line = $in_fh->getline;
89             }
90 81 100 66     9586 if ( ( $line eq '' or $line =~ /^\s+$/ ) and $content ne '' ) {
      66        
91 9         43 my $info_of = App::Fasops::Common::parse_block($content);
92 9         23 $content = '';
93              
94 9 100       33 if ( lc( $opt->{outdir} ) eq "stdout" ) {
95 6         12 for my $key ( keys %{$info_of} ) {
  6         31  
96 24 100       619 if ( $opt->{simple} ) {
97 12         37 printf ">%s\n", $info_of->{$key}{name};
98             }
99             else {
100 12         44 printf ">%s\n", App::RL::Common::encode_header( $info_of->{$key} );
101             }
102 24         2551 print $info_of->{$key}{seq} . "\n";
103             }
104             }
105             else {
106 3         5 my $target = ( keys %{$info_of} )[0];
  3         13  
107 3         75 my $filename;
108 3 50       9 if ( $opt->{chr} ) {
109 3         11 $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         127 open my $out_fh, ">>", $filename;
121 3         2567 for my $key ( keys %{$info_of} ) {
  3         15  
122 12 50       189 if ( $opt->{simple} ) {
123 0         0 printf {$out_fh} ">%s\n", $info_of->{$key}{name};
  0         0  
124             }
125             else {
126 12         41 printf {$out_fh} ">%s\n",
127 12         20 App::RL::Common::encode_header( $info_of->{$key} );
128             }
129 12         1877 print {$out_fh} $info_of->{$key}{seq} . "\n";
  12         44  
130             }
131 3         36 print {$out_fh} "\n";
  3         8  
132 3         10 close $out_fh;
133             }
134             }
135             else {
136 72         152 $content .= $line;
137             }
138             }
139              
140 3         516 $in_fh->close;
141             }
142             }
143              
144             1;