File Coverage

blib/lib/App/RL/Command/gff.pm
Criterion Covered Total %
statement 64 67 95.5
branch 17 20 85.0
condition n/a
subroutine 11 11 100.0
pod 6 6 100.0
total 98 104 94.2


line stmt bran cond sub pod time code
1             package App::RL::Command::gff;
2 15     15   15820 use strict;
  15         54  
  15         695  
3 15     15   101 use warnings;
  15         36  
  15         694  
4 15     15   102 use autodie;
  15         38  
  15         131  
5              
6 15     15   99276 use App::RL -command;
  15         43  
  15         254  
7 15     15   7635 use App::RL::Common;
  15         49  
  15         17944  
8              
9             sub abstract {
10 2     2 1 92 return 'convert gff3 files to chromosome runlists';
11             }
12              
13             sub opt_spec {
14             return (
15 6     6 1 50 [ "outfile|o=s", "output filename. [stdout] for screen" ],
16             [ "tag|t=s", "primary tag (the third field)" ],
17             [ "remove|r", "remove 'chr0' from chromosome names" ],
18             { show_defaults => 1, }
19             );
20             }
21              
22             sub usage_desc {
23 6     6 1 71197 return "runlist gff [options] [more infiles]";
24             }
25              
26             sub description {
27 1     1 1 1073 my $desc;
28 1         5 $desc .= ucfirst(abstract) . ".\n";
29 1         3 $desc .= <<'MARKDOWN';
30              
31             * .gff files can be gzipped
32              
33             MARKDOWN
34              
35 1         4 return $desc;
36             }
37              
38             sub validate_args {
39 5     5 1 5897 my ( $self, $opt, $args ) = @_;
40              
41 5 100       10 if ( @{$args} < 1 ) {
  5         23  
42 1         4 my $message = "This command need one or more input files.\n\tIt found";
43 1         3 $message .= sprintf " [%s]", $_ for @{$args};
  1         5  
44 1         3 $message .= ".\n";
45 1         11 $self->usage_error($message);
46             }
47 4         8 for ( @{$args} ) {
  4         11  
48 4 50       18 next if lc $_ eq "stdin";
49 4 100       27 if ( !Path::Tiny::path($_)->is_file ) {
50 1         143 $self->usage_error("The input file [$_] doesn't exist.");
51             }
52             }
53              
54 3 50       324 if ( !exists $opt->{outfile} ) {
55 0         0 $opt->{outfile} = Path::Tiny::path( $args->[0] )->absolute . ".yml";
56             }
57             }
58              
59             sub execute {
60 3     3 1 28 my ( $self, $opt, $args ) = @_;
61              
62             #----------------------------#
63             # Loading
64             #----------------------------#
65 3         8 my $set_of = {};
66 3         9 for my $infile ( @{$args} ) {
  3         10  
67 3         21 my @lines = App::RL::Common::read_lines($infile);
68              
69 3         18 for my $line (@lines) {
70 770 100       45124 next if substr( $line, 0, 1 ) eq "#";
71              
72 756         2494 my @array = split( "\t", $line );
73 756         1221 my $feature_type = $array[2];
74              
75 756 100       1684 if ( defined $opt->{tag} ) {
76 329 100       916 next if $opt->{tag} ne $feature_type;
77             }
78              
79 526         689 my $chr_name = $array[0];
80 526         686 my $chr_start = $array[3];
81 526         690 my $chr_end = $array[4];
82              
83 526 50       914 if ( $opt->{remove} ) {
84 0         0 $chr_name =~ s/chr0?//i;
85 0         0 $chr_name =~ s/\.\d+$//;
86             }
87 526 100       985 if ( !exists $set_of->{$chr_name} ) {
88 3         21 $set_of->{$chr_name} = App::RL::Common::new_set;
89             }
90 526         1279 $set_of->{$chr_name}->add_pair( $chr_start, $chr_end );
91             }
92             }
93              
94             # IntSpan to runlist
95 3         306 for my $chr_name ( keys %{$set_of} ) {
  3         24  
96 3         16 $set_of->{$chr_name} = $set_of->{$chr_name}->runlist;
97             }
98              
99             #----------------------------#
100             # Output
101             #----------------------------#
102 3         1264 my $out_fh;
103 3 100       38 if ( lc( $opt->{outfile} ) eq "stdout" ) {
104 1         9 $out_fh = *STDOUT;
105             }
106             else {
107 2         23 open $out_fh, ">", $opt->{outfile};
108             }
109              
110 3         2934 print {$out_fh} YAML::Syck::Dump($set_of);
  3         26  
111              
112 3         417 close $out_fh;
113             }
114              
115             1;