File Coverage

blib/lib/App/RL/Command/combine.pm
Criterion Covered Total %
statement 73 75 97.3
branch 9 12 75.0
condition n/a
subroutine 11 11 100.0
pod 5 5 100.0
total 98 103 95.1


line stmt bran cond sub pod time code
1             package App::RL::Command::combine;
2 14     14   174698 use strict;
  14         34  
  14         412  
3 14     14   72 use warnings;
  14         31  
  14         430  
4 14     14   6041 use autodie;
  14         179192  
  14         63  
5              
6 14     14   89953 use App::RL -command;
  14         38  
  14         184  
7 14     14   11981 use App::RL::Common;
  14         51  
  14         530  
8              
9 14     14   105 use constant abstract => 'combine multiple sets of runlists';
  14         196  
  14         9068  
10              
11             sub opt_spec {
12             return (
13 5     5 1 26 [ "outfile|o=s", "Output filename. [stdout] for screen." ],
14             [ "remove|r", "Remove 'chr0' from chromosome names." ],
15             );
16             }
17              
18             sub usage_desc {
19 5     5 1 38451 my $self = shift;
20 5         21 my $desc = $self->SUPER::usage_desc; # "%c COMMAND %o"
21 5         84 $desc .= " ";
22 5         21 return $desc;
23             }
24              
25             sub description {
26 1     1 1 665 my $desc;
27 1         3 $desc .= ucfirst(abstract) . ".\n";
28 1         2 $desc .= " " x 4 . "It's expected that the YAML file is --mk.\n";
29 1         3 $desc .= " " x 4 . "Otherwise this command will make no effects.\n";
30 1         3 return $desc;
31             }
32              
33             sub validate_args {
34 4     4 1 2951 my ( $self, $opt, $args ) = @_;
35              
36 4 100       8 if ( @{$args} != 1 ) {
  4         15  
37 1         3 my $message = "This command need one input file.\n\tIt found";
38 1         2 $message .= sprintf " [%s]", $_ for @{$args};
  1         3  
39 1         3 $message .= ".\n";
40 1         8 $self->usage_error($message);
41             }
42 3         7 for ( @{$args} ) {
  3         8  
43 3 50       12 next if lc $_ eq "stdin";
44 3 100       13 if ( !Path::Tiny::path($_)->is_file ) {
45 1         105 $self->usage_error("The input file [$_] doesn't exist.");
46             }
47             }
48              
49 2 50       131 if ( !exists $opt->{outfile} ) {
50 0         0 $opt->{outfile} = Path::Tiny::path( $args->[0] )->absolute . ".combine.yml";
51             }
52             }
53              
54             sub execute {
55 2     2 1 12 my ( $self, $opt, $args ) = @_;
56              
57             #----------------------------#
58             # Loading
59             #----------------------------#
60 2         4 my $s_of = {};
61 2         23 my $all_name_set = Set::Scalar->new;
62              
63 2         262 my $yml = YAML::Syck::LoadFile( $args->[0] );
64 2         370 my @keys = sort keys %{$yml};
  2         11  
65              
66 2 100       9 if ( ref $yml->{ $keys[0] } eq 'HASH' ) {
67 1         3 for my $key (@keys) {
68 5         217 $s_of->{$key} = App::RL::Common::runlist2set( $yml->{$key}, $opt->{remove} );
69 5         10 $all_name_set->insert( keys %{ $s_of->{$key} } );
  5         25  
70             }
71             }
72             else {
73 1         4 @keys = ("__single");
74             $s_of->{__single}
75 1         6 = App::RL::Common::runlist2set( $yml, $opt->{remove} );
76 1         3 $all_name_set->insert( keys %{ $s_of->{__single} } );
  1         7  
77             }
78              
79             #----------------------------#
80             # Operating
81             #----------------------------#
82 2         122 my $op_result_of = { map { $_ => App::RL::Common::new_set() } $all_name_set->members };
  3         30  
83              
84 2         23 for my $key (@keys) {
85 6         2224 my $s = $s_of->{$key};
86 6         9 for my $chr ( keys %{$s} ) {
  6         16  
87 6         17 $op_result_of->{$chr}->add( $s->{$chr} );
88             }
89             }
90              
91             # convert sets to runlists
92 2         1990 for my $chr ( keys %{$op_result_of} ) {
  2         6  
93 3         117 $op_result_of->{$chr} = $op_result_of->{$chr}->runlist;
94             }
95              
96             #----------------------------#
97             # Output
98             #----------------------------#
99 2         234 my $out_fh;
100 2 50       9 if ( lc( $opt->{outfile} ) eq "stdout" ) {
101 2         8 $out_fh = *STDOUT;
102             }
103             else {
104 0         0 open $out_fh, ">", $opt->{outfile};
105             }
106              
107 2         4 print {$out_fh} YAML::Syck::Dump($op_result_of);
  2         8  
108              
109 2         155 close $out_fh;
110             }
111              
112             1;