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 20     20   13926 use strict;
  20         59  
  20         612  
3 20     20   111 use warnings;
  20         43  
  20         500  
4 20     20   104 use autodie;
  20         51  
  20         108  
5              
6 20     20   105393 use App::Fasops -command;
  20         61  
  20         198  
7 20     20   6807 use App::Fasops::Common;
  20         43  
  20         17481  
8              
9             sub abstract {
10 2     2 1 49 return 'scan blocked fasta files and output all species names';
11             }
12              
13             sub opt_spec {
14             return (
15 5     5 1 32 [ "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 49190 return "fasops names [options] [more infiles]";
23             }
24              
25             sub description {
26 1     1 1 789 my $desc;
27 1         5 $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         3 return $desc;
36             }
37              
38             sub validate_args {
39 4     4 1 3428 my ( $self, $opt, $args ) = @_;
40              
41 4 100       6 if ( !@{$args} ) {
  4         16  
42 1         2 my $message = "This command need one or more input files.\n\tIt found";
43 1         2 $message .= sprintf " [%s]", $_ for @{$args};
  1         3  
44 1         4 $message .= ".\n";
45 1         18 $self->usage_error($message);
46             }
47 3         7 for ( @{$args} ) {
  3         8  
48 3 50       12 next if lc $_ eq "stdin";
49 3 100       15 if ( !Path::Tiny::path($_)->is_file ) {
50 1         137 $self->usage_error("The input file [$_] doesn't exist.");
51             }
52             }
53              
54 2 50       152 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 14 my ( $self, $opt, $args ) = @_;
61              
62 2         19 tie my %count_of, "Tie::IxHash";
63 2         35 for my $infile ( @{$args} ) {
  2         5  
64 2         3 my $in_fh;
65 2 50       7 if ( lc $infile eq "stdin" ) {
66 0         0 $in_fh = *STDIN{IO};
67             }
68             else {
69 2         16 $in_fh = IO::Zlib->new( $infile, "rb" );
70             }
71              
72 2         3434 my $content = ''; # content of one block
73 2         5 while (1) {
74 56 100 66     422 last if $in_fh->eof and $content eq '';
75 54         2356 my $line = '';
76 54 50       166 if ( !$in_fh->eof ) {
77 54         2096 $line = $in_fh->getline;
78             }
79 54 100 66     6314 if ( ( $line eq '' or $line =~ /^\s+$/ ) and $content ne '' ) {
      66        
80 6         23 my $info_of = App::Fasops::Common::parse_block($content);
81 6         12 $content = '';
82              
83 6         10 for my $key ( keys %{$info_of} ) {
  6         20  
84 24         430 my $name = $info_of->{$key}{name};
85 24         256 $count_of{$name}++;
86             }
87             }
88             else {
89 48         88 $content .= $line;
90             }
91             }
92              
93 2         334 $in_fh->close;
94             }
95              
96 2         330 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         125 print {$out_fh} $_;
  8         33  
105 8 100       116 print {$out_fh} "\t" . $count_of{$_} if $opt->{count};
  4         16  
106 8         123 print {$out_fh} "\n";
  8         27  
107             }
108 2         34 close $out_fh;
109             }
110              
111             1;