File Coverage

blib/lib/App/Fasops/Command/separate.pm
Criterion Covered Total %
statement 69 77 89.6
branch 19 28 67.8
condition 9 12 75.0
subroutine 12 12 100.0
pod 6 6 100.0
total 115 135 85.1


line stmt bran cond sub pod time code
1             package App::Fasops::Command::separate;
2 21     21   15003 use strict;
  21         52  
  21         672  
3 21     21   115 use warnings;
  21         47  
  21         525  
4 21     21   138 use autodie;
  21         46  
  21         121  
5              
6 21     21   108513 use App::Fasops -command;
  21         104  
  21         212  
7 21     21   7335 use App::RL::Common;
  21         52  
  21         739  
8 21     21   131 use App::Fasops::Common;
  21         46  
  21         21399  
9              
10             sub abstract {
11 2     2 1 48 return 'separate blocked fasta files by species';
12             }
13              
14             sub opt_spec {
15             return (
16 5     5 1 65 [ "outdir|o=s", "Output location, [stdout] for screen", { default => '.' } ],
17             [ "suffix|s=s", "Extensions of output files", { default => '.fasta' } ],
18             [ "rm|r", "If outdir exists, remove it before operating" ],
19             [ "rc", "Revcom sequences when chr_strand is '-'" ],
20             [ "nodash", "Remove dashes ('-') from sequences" ],
21             { show_defaults => 1, }
22             );
23             }
24              
25             sub usage_desc {
26 5     5 1 51392 return "fasops separate [options] [more infiles]";
27             }
28              
29             sub description {
30 1     1 1 1297 my $desc;
31 1         5 $desc .= ucfirst(abstract) . ".\n";
32 1         2 $desc .= <<'MARKDOWN';
33              
34             * are paths to axt files, .axt.gz is supported
35             * infile == stdin means reading from STDIN
36              
37             MARKDOWN
38              
39 1         4 return $desc;
40             }
41              
42             sub validate_args {
43 4     4 1 5871 my ( $self, $opt, $args ) = @_;
44              
45 4 100       9 if ( !@{$args} ) {
  4         15  
46 1         4 my $message = "This command need one or more input files.\n\tIt found";
47 1         2 $message .= sprintf " [%s]", $_ for @{$args};
  1         5  
48 1         4 $message .= ".\n";
49 1         13 $self->usage_error($message);
50             }
51 3         6 for ( @{$args} ) {
  3         8  
52 3 50       14 next if lc $_ eq "stdin";
53 3 100       15 if ( !Path::Tiny::path($_)->is_file ) {
54 1         136 $self->usage_error("The input file [$_] doesn't exist.");
55             }
56             }
57              
58 2 50       159 if ( !exists $opt->{outdir} ) {
59 0         0 $opt->{outdir} = Path::Tiny::path( $args->[0] )->absolute . ".separate";
60             }
61 2 50       52 if ( -e $opt->{outdir} ) {
62 0 0       0 if ( $opt->{rm} ) {
63 0         0 Path::Tiny::path( $opt->{outdir} )->remove_tree;
64             }
65             }
66              
67 2 50       16 if ( lc( $opt->{outdir} ) ne "stdout" ) {
68 0         0 Path::Tiny::path( $opt->{outdir} )->mkpath;
69             }
70             }
71              
72             sub execute {
73 2     2 1 15 my ( $self, $opt, $args ) = @_;
74              
75 2         5 for my $infile ( @{$args} ) {
  2         6  
76 2         5 my $in_fh;
77 2 50       10 if ( lc $infile eq "stdin" ) {
78 0         0 $in_fh = *STDIN{IO};
79             }
80             else {
81 2         26 $in_fh = IO::Zlib->new( $infile, "rb" );
82             }
83              
84 2         3576 my $content = ''; # content of one block
85 2         3 while (1) {
86 56 100 66     392 last if $in_fh->eof and $content eq '';
87 54         2453 my $line = '';
88 54 50       197 if ( !$in_fh->eof ) {
89 54         2181 $line = $in_fh->getline;
90             }
91 54 100 66     6572 if ( ( $line eq '' or $line =~ /^\s+$/ ) and $content ne '' ) {
      66        
92 6         25 my $info_of = App::Fasops::Common::parse_block($content);
93 6         17 $content = '';
94              
95 6         8 for my $key ( keys %{$info_of} ) {
  6         21  
96 24         512 my $info = $info_of->{$key};
97 24 100       162 if ( $opt->{nodash} ) {
98 12         36 $info->{seq} =~ tr/-//d;
99             }
100 24 100 100     233 if ( $opt->{rc} and $info->{strand} ne "+" ) {
101             $info->{seq}
102 6         55 = App::Fasops::Common::revcom( $info->{seq} );
103 6         69 $info->{strand} = "+";
104             }
105              
106 24 50       148 if ( lc( $opt->{outdir} ) eq "stdout" ) {
107 24         59 print ">" . App::RL::Common::encode_header($info) . "\n";
108 24         4030 print $info->{seq} . "\n";
109             }
110             else {
111             my $outfile
112 0         0 = Path::Tiny::path( $opt->{outdir}, $info->{name} . $opt->{suffix} );
113 0         0 $outfile->append( ">" . App::RL::Common::encode_header($info) . "\n" );
114 0         0 $outfile->append( $info->{seq} . "\n" );
115             }
116             }
117             }
118             else {
119 48         109 $content .= $line;
120             }
121             }
122              
123 2         350 $in_fh->close;
124             }
125             }
126              
127             1;