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 20     20   13922 use strict;
  20         52  
  20         676  
3 20     20   110 use warnings;
  20         44  
  20         510  
4 20     20   129 use autodie;
  20         38  
  20         126  
5              
6 20     20   106880 use App::Fasops -command;
  20         56  
  20         218  
7 20     20   7592 use App::RL::Common;
  20         46  
  20         620  
8 20     20   118 use App::Fasops::Common;
  20         38  
  20         20194  
9              
10             sub abstract {
11 2     2 1 46 return 'separate blocked fasta files by species';
12             }
13              
14             sub opt_spec {
15             return (
16 5     5 1 44 [ "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 49040 return "fasops separate [options] [more infiles]";
27             }
28              
29             sub description {
30 1     1 1 1308 my $desc;
31 1         5 $desc .= ucfirst(abstract) . ".\n";
32 1         3 $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 5770 my ( $self, $opt, $args ) = @_;
44              
45 4 100       25 if ( !@{$args} ) {
  4         17  
46 1         3 my $message = "This command need one or more input files.\n\tIt found";
47 1         3 $message .= sprintf " [%s]", $_ for @{$args};
  1         3  
48 1         5 $message .= ".\n";
49 1         10 $self->usage_error($message);
50             }
51 3         6 for ( @{$args} ) {
  3         9  
52 3 50       10 next if lc $_ eq "stdin";
53 3 100       13 if ( !Path::Tiny::path($_)->is_file ) {
54 1         110 $self->usage_error("The input file [$_] doesn't exist.");
55             }
56             }
57              
58 2 50       143 if ( !exists $opt->{outdir} ) {
59 0         0 $opt->{outdir} = Path::Tiny::path( $args->[0] )->absolute . ".separate";
60             }
61 2 50       48 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       14 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 14 my ( $self, $opt, $args ) = @_;
74              
75 2         5 for my $infile ( @{$args} ) {
  2         7  
76 2         5 my $in_fh;
77 2 50       8 if ( lc $infile eq "stdin" ) {
78 0         0 $in_fh = *STDIN{IO};
79             }
80             else {
81 2         14 $in_fh = IO::Zlib->new( $infile, "rb" );
82             }
83              
84 2         3489 my $content = ''; # content of one block
85 2         4 while (1) {
86 56 100 66     393 last if $in_fh->eof and $content eq '';
87 54         2327 my $line = '';
88 54 50       166 if ( !$in_fh->eof ) {
89 54         2106 $line = $in_fh->getline;
90             }
91 54 100 66     6289 if ( ( $line eq '' or $line =~ /^\s+$/ ) and $content ne '' ) {
      66        
92 6         27 my $info_of = App::Fasops::Common::parse_block($content);
93 6         14 $content = '';
94              
95 6         8 for my $key ( keys %{$info_of} ) {
  6         21  
96 24         514 my $info = $info_of->{$key};
97 24 100       162 if ( $opt->{nodash} ) {
98 12         38 $info->{seq} =~ tr/-//d;
99             }
100 24 100 100     283 if ( $opt->{rc} and $info->{strand} ne "+" ) {
101             $info->{seq}
102 6         81 = App::Fasops::Common::revcom( $info->{seq} );
103 6         68 $info->{strand} = "+";
104             }
105              
106 24 50       156 if ( lc( $opt->{outdir} ) eq "stdout" ) {
107 24         61 print ">" . App::RL::Common::encode_header($info) . "\n";
108 24         4207 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         94 $content .= $line;
120             }
121             }
122              
123 2         347 $in_fh->close;
124             }
125             }
126              
127             1;