File Coverage

blib/lib/App/Fasops/Command/names.pm
Criterion Covered Total %
statement 69 72 95.8
branch 15 20 75.0
condition 6 9 66.6
subroutine 11 11 100.0
pod 6 6 100.0
total 107 118 90.6


line stmt bran cond sub pod time code
1             package App::Fasops::Command::names;
2 21     21   14754 use strict;
  21         50  
  21         644  
3 21     21   106 use warnings;
  21         46  
  21         522  
4 21     21   105 use autodie;
  21         39  
  21         119  
5              
6 21     21   107894 use App::Fasops -command;
  21         52  
  21         226  
7 21     21   7409 use App::Fasops::Common;
  21         49  
  21         18515  
8              
9             sub abstract {
10 2     2 1 54 return 'scan blocked fasta files and output all species names';
11             }
12              
13             sub opt_spec {
14             return (
15 5     5 1 48 [ "outfile|o=s", "Output filename. [stdout] for screen" ],
16             [ "count|c", "Also count name occurrences" ],
17             { show_defaults => 1, }
18             );
19             }
20              
21             sub usage_desc {
22 5     5 1 52411 return "fasops names [options] [more infiles]";
23             }
24              
25             sub description {
26 1     1 1 788 my $desc;
27 1         4 $desc .= ucfirst(abstract) . ".\n";
28 1         3 $desc .= <<'MARKDOWN';
29              
30             * are paths to axt files, .axt.gz is supported
31             * infile == stdin means reading from STDIN
32              
33             MARKDOWN
34              
35 1         4 return $desc;
36             }
37              
38             sub validate_args {
39 4     4 1 3411 my ( $self, $opt, $args ) = @_;
40              
41 4 100       8 if ( !@{$args} ) {
  4         14  
42 1         3 my $message = "This command need one or more input files.\n\tIt found";
43 1         2 $message .= sprintf " [%s]", $_ for @{$args};
  1         4  
44 1         4 $message .= ".\n";
45 1         9 $self->usage_error($message);
46             }
47 3         7 for ( @{$args} ) {
  3         9  
48 3 50       11 next if lc $_ eq "stdin";
49 3 100       17 if ( !Path::Tiny::path($_)->is_file ) {
50 1         141 $self->usage_error("The input file [$_] doesn't exist.");
51             }
52             }
53              
54 2 50       187 if ( !exists $opt->{outfile} ) {
55 0         0 $opt->{outfile} = Path::Tiny::path( $args->[0] )->absolute . ".list";
56             }
57             }
58              
59             sub execute {
60 2     2 1 15 my ( $self, $opt, $args ) = @_;
61              
62 2         20 tie my %count_of, "Tie::IxHash";
63 2         36 for my $infile ( @{$args} ) {
  2         7  
64 2         3 my $in_fh;
65 2 50       10 if ( lc $infile eq "stdin" ) {
66 0         0 $in_fh = *STDIN{IO};
67             }
68             else {
69 2         30 $in_fh = IO::Zlib->new( $infile, "rb" );
70             }
71              
72 2         4024 my $content = ''; # content of one block
73 2         4 while (1) {
74 56 100 66     362 last if $in_fh->eof and $content eq '';
75 54         2359 my $line = '';
76 54 50       169 if ( !$in_fh->eof ) {
77 54         2115 $line = $in_fh->getline;
78             }
79 54 100 66     6343 if ( ( $line eq '' or $line =~ /^\s+$/ ) and $content ne '' ) {
      66        
80 6         37 my $info_of = App::Fasops::Common::parse_block($content);
81 6         13 $content = '';
82              
83 6         11 for my $key ( keys %{$info_of} ) {
  6         22  
84 24         521 my $name = $info_of->{$key}{name};
85 24         258 $count_of{$name}++;
86             }
87             }
88             else {
89 48         104 $content .= $line;
90             }
91             }
92              
93 2         338 $in_fh->close;
94             }
95              
96 2         408 my $out_fh;
97 2 50       10 if ( lc( $opt->{outfile} ) eq "stdout" ) {
98 2         7 $out_fh = *STDOUT{IO};
99             }
100             else {
101 0         0 open $out_fh, ">", $opt->{outfile};
102             }
103 2         10 for ( keys %count_of ) {
104 8         122 print {$out_fh} $_;
  8         32  
105 8 100       123 print {$out_fh} "\t" . $count_of{$_} if $opt->{count};
  4         18  
106 8         86 print {$out_fh} "\n";
  8         25  
107             }
108 2         34 close $out_fh;
109             }
110              
111             1;