File Coverage

blib/lib/GenOO/Data/Structure/DoubleHashArray.pm
Criterion Covered Total %
statement 70 71 98.5
branch 14 16 87.5
condition 5 9 55.5
subroutine 14 14 100.0
pod 0 10 0.0
total 103 120 85.8


line stmt bran cond sub pod time code
1             # POD documentation - main docs before the code
2              
3             =head1 NAME
4              
5             GenOO::Data::Structure::DoubleHashArray - Object for a data structure which corresponds of a 2D hash whose values are references to array
6              
7             =head1 SYNOPSIS
8              
9             # To initialize
10             my $structure = GenOO::Data::Structure::DoubleHashArray->new();
11              
12              
13             =head1 DESCRIPTION
14              
15             This class corresponds to a data structure which is a 2D hash whose primary key could be for
16             example the strand, its secondary key the chromosome and each value an array reference with
17             objects that consume the L<GenOO::Region> role.
18              
19             =head1 EXAMPLES
20              
21             # Add an entry to the structure
22             $structure->add_entry($primary_key, $secondary_key, $entry);
23              
24             =cut
25              
26             # Let the code begin...
27              
28             package GenOO::Data::Structure::DoubleHashArray;
29             $GenOO::Data::Structure::DoubleHashArray::VERSION = '1.4.6';
30              
31             #######################################################################
32             ####################### Load External modules #####################
33             #######################################################################
34 1     1   3 use Modern::Perl;
  1         2  
  1         5  
35 1     1   88 use autodie;
  1         1  
  1         4  
36 1     1   3246 use Moose;
  1         1  
  1         4  
37 1     1   5017 use namespace::autoclean;
  1         1  
  1         6  
38              
39              
40             #######################################################################
41             ####################### Interface attributes ######################
42             #######################################################################
43             has 'sorting_code_block' => (
44             isa => 'CodeRef',
45             is => 'ro',
46             default => sub { sub {return $_[0] <=> $_[1]} }
47             );
48              
49             has 'entries_count' => (
50             traits => ['Counter'],
51             is => 'ro',
52             isa => 'Num',
53             default => 0,
54             handles => {
55             _inc_entries_count => 'inc',
56             _reset_entries_count => 'reset',
57             },
58             );
59              
60             has 'is_sorted' => (
61             traits => ['Bool'],
62             is => 'rw',
63             isa => 'Bool',
64             default => 0,
65             handles => {
66             _set_is_sorted => 'set',
67             _unset_is_sorted => 'unset',
68             is_not_sorted => 'not',
69             },
70             );
71              
72              
73             #######################################################################
74             ######################## Private attributes #######################
75             #######################################################################
76             has '_structure' => (
77             traits => ['Hash'],
78             is => 'ro',
79             isa => 'HashRef[HashRef[ArrayRef]]',
80             default => sub { {} },
81             );
82              
83              
84             #######################################################################
85             ######################## Interface Methods ########################
86             #######################################################################
87             sub foreach_entry_do {
88 16     16 0 486 my ($self, $block) = @_;
89            
90 16         35 A: foreach my $primary_key (keys %{$self->_structure}) {
  16         534  
91 31         43 foreach my $secondary_key (keys %{$self->_structure->{$primary_key}}) {
  31         950  
92 53         52 foreach my $entry (@{$self->_structure->{$primary_key}->{$secondary_key}}) {
  53         1641  
93 328         554 my $return_code = $block->($entry);
94 328 100 66     1289 last A if (defined $return_code and $return_code eq 'break_loop');
95             }
96             }
97             }
98 16         56 return 0;
99             }
100              
101             sub foreach_entry_on_secondary_key_do {
102 2     2 0 561 my ($self, $secondary_key, $block) = @_;
103            
104 2         6 A: foreach my $primary_key (keys %{$self->_structure}) {
  2         86  
105 4 100       120 next if not defined $self->_structure->{$primary_key}->{$secondary_key};
106 2         3 foreach my $entry (@{$self->_structure->{$primary_key}->{$secondary_key}}) {
  2         58  
107 6         15 my $return_code = $block->($entry);
108 6 50 33     53 last A if (defined $return_code and $return_code eq 'break_loop');
109             }
110             }
111             }
112              
113             sub add_entry {
114 1937     1937 0 3371 my ($self, $primary_key, $secondary_key, $entry) = @_;
115            
116 1937 100       54366 unless (exists $self->_structure->{$primary_key}) {
117 113         3200 $self->_structure->{$primary_key} = {};
118             }
119 1937         1801 push @{$self->_structure->{$primary_key}->{$secondary_key}}, $entry;
  1937         53506  
120            
121 1937         71393 $self->_inc_entries_count;
122 1937         70318 $self->_unset_is_sorted;
123             }
124              
125             sub primary_keys {
126 4     4 0 651 my ($self) = @_;
127 4         9 return sort keys %{$self->_structure};
  4         163  
128             }
129              
130             sub secondary_keys_for_primary_key {
131 8     8 0 588 my ($self, $primary_key) = @_;
132 8         9 return sort keys %{$self->_structure->{$primary_key}};
  8         253  
133             }
134              
135             sub secondary_keys_for_all_primary_keys {
136 2     2 0 638 my ($self) = @_;
137            
138 2         6 my %secondary_keys;
139 2         8 foreach my $primary_key ($self->primary_keys) {
140 4         13 foreach my $secondary_key ($self->secondary_keys_for_primary_key($primary_key)) {
141 8         16 $secondary_keys{$secondary_key} = 1;
142             }
143             }
144 2         20 return (sort keys %secondary_keys);
145             }
146              
147             sub is_empty {
148 3     3 0 8 my ($self) = @_;
149            
150 3 100       95 if ($self->entries_count == 0) {
151 1         7 return 1;
152             }
153             else {
154 2         9 return 0;
155             }
156             }
157              
158             sub is_not_empty {
159 3     3 0 10 my ($self) = @_;
160            
161 3 100 66     95 if (defined $self->entries_count and $self->entries_count > 0) {
162 2         9 return 1;
163             }
164             else {
165 1         8 return 0;
166             }
167             }
168              
169             sub sort_entries {
170 4     4 0 12 my ($self) = @_;
171            
172 4 100       187 if ($self->is_not_sorted) {
173 3         7 foreach my $primary_key (keys %{$self->_structure}) {
  3         116  
174 6         13 foreach my $secondary_key (keys %{$self->_structure->{$primary_key}}) {
  6         209  
175 12         412 my $entries_ref = $self->_structure->{$primary_key}->{$secondary_key};
176 12         38 @$entries_ref = sort {$self->sorting_code_block->($a,$b)} @$entries_ref;
  34         1206  
177             }
178             }
179 3         152 $self->_set_is_sorted();
180             }
181             }
182              
183             sub entries_ref_for_keys {
184 7     7 0 490 my ($self, $primary_key, $secondary_key) = @_;
185            
186 7 50       258 if (exists $self->_structure->{$primary_key}) {
187 7         220 return $self->_structure->{$primary_key}->{$secondary_key};
188             }
189             else {
190 0           return undef;
191             }
192             }
193              
194              
195             #######################################################################
196             ############################ Finalize #############################
197             #######################################################################
198             __PACKAGE__->meta->make_immutable;
199              
200             1;