File Coverage

blib/lib/Bio/Gonzales/Feat/IO/Base.pm
Criterion Covered Total %
statement 63 70 90.0
branch 9 10 90.0
condition 7 9 77.7
subroutine 8 14 57.1
pod 0 6 0.0
total 87 109 79.8


line stmt bran cond sub pod time code
1             package Bio::Gonzales::Feat::IO::Base;
2              
3              
4 3     3   1652 use warnings;
  3         16  
  3         110  
5 3     3   17 use strict;
  3         6  
  3         61  
6 3     3   15 use Carp;
  3         6  
  3         151  
7              
8 3     3   18 use Mouse;
  3         6  
  3         19  
9              
10              
11 3     3   1222 use 5.010;
  3         12  
12              
13             with 'Bio::Gonzales::Util::Role::FileIO';
14              
15             our $VERSION = '0.083'; # VERSION
16              
17             has _collection => ( is => 'rw', default => sub { { subfeats => {}, feats => {} } } );
18             has _num => ( is => 'rw', default => 0 );
19              
20             # file handle iterator
21              
22             sub next_feat {
23 0     0 0 0 confess 'function not implemented, yet';
24             }
25              
26             sub write_feat {
27 0     0 0 0 confess 'function not implemented, yet';
28             }
29              
30 0     0 0 0 sub write_feature { return shift->write_feat(@_); }
31              
32 0     0 0 0 sub next_feature { return shift->next_feat(@_); }
33              
34             sub write_collected_feats {
35 0     0 0 0 confess 'function not implemented, yet';
36             }
37              
38             sub _find_parent_feats {
39 1     1   4 my ($self) = @_;
40              
41 1         2 my @parents;
42 1         5 for my $fs ( values %{ $self->_collection->{feats} } ) {
  1         7  
43 54         80 push @parents, grep { @{ $_->parentfeats } == 0 } @$fs;
  57         70  
  57         132  
44             }
45 1         4 return \@parents;
46             }
47              
48             sub _connect_feats {
49 1     1   3 my ($self) = @_;
50              
51 1         5 my $subfeats = $self->_collection->{subfeats};
52 1         5 my $feats = $self->_collection->{feats};
53              
54 1         27 for my $id ( keys %$feats ) {
55 54         90 my $fs = $feats->{$id};
56 54         99 for my $f (@$fs) {
57 57 100       103 if ( exists( $subfeats->{$id} ) ) {
58 9         11 push @{ $f->subfeats }, @{ $subfeats->{$id} };
  9         22  
  9         27  
59 9         14 map { push @{ $_->parentfeats }, $f } @{ $subfeats->{$id} };
  34         43  
  34         76  
  9         16  
60             }
61 57         147 $f->uniq;
62 57         160 $f->sort_subfeats;
63             }
64             }
65             }
66              
67             sub collect_feat {
68 0     0 0 0 my ( $self, @feats ) = @_;
69              
70 0         0 confess 'function deprecated';
71             }
72              
73             sub _collect_feat {
74 57     57   97 my ( $self, $f ) = @_;
75              
76 57         139 my $subfeats = $self->_collection->{subfeats};
77 57         106 my $feats = $self->_collection->{feats};
78              
79 57         146 my @parents = $f->parent_ids;
80 57 100 66     203 if ( @parents && @parents > 0 ) {
81 31         56 for my $p (@parents) {
82             # feat has a parent so we have an exon
83 34   100     113 $subfeats->{$p} //= [];
84 34         52 push @{ $subfeats->{$p} }, $f;
  34         86  
85             }
86             }
87              
88 57 100       123 if ( $f->ids ) {
89 27         59 for my $id ( $f->ids() ) {
90 27   100     127 $feats->{$id} //= [];
91 27         41 push @{ $feats->{$id} }, $f;
  27         68  
92             }
93             } else {
94 30         54 my $id = "__noid_";
95 30 100       67 $id .= $f->name . "_" if ( $f->name );
96 30 50       144 $id .= $f->type . "_" if ( $f->type );
97 30         82 $id .= $self->_num;
98 30         92 $self->_num( $self->_num + 1 );
99 30         81 $f->add_attr( "ID" => $id );
100              
101 30   50     146 $feats->{$id} //= [];
102 30         40 push @{ $feats->{$id} }, $f;
  30         65  
103              
104 30         77 carp "feature has no id, made artificial one: " . $f->id;
105             }
106              
107 57         2407 return;
108             }
109              
110             1;