File Coverage

blib/lib/GenOO/RegionCollection/Type/DBIC.pm
Criterion Covered Total %
statement 67 86 77.9
branch 7 16 43.7
condition 3 6 50.0
subroutine 24 29 82.7
pod 0 20 0.0
total 101 157 64.3


line stmt bran cond sub pod time code
1             # POD documentation - main docs before the code
2              
3             =head1 NAME
4              
5             GenOO::RegionCollection::Type::DBIC - Class for a collection of GenOO::Region objects stored in a database.
6              
7             =head1 SYNOPSIS
8              
9             # Object that corresponds to a collection of GenOO::Region objects.
10             # To initialize
11             my $region_collection = GenOO::RegionCollection::DB->new(
12             driver => undef,
13             host => undef,
14             database => undef,
15             table => undef,
16             user => undef,
17             password => undef,
18             port => undef,
19             name => undef,
20             species => undef,
21             description => undef,
22             extra => undef,
23             );
24              
25              
26             =head1 DESCRIPTION
27              
28             This class consumes the L<GenOO::RegionCollection> role.
29             An instance of this class corresponds to a collection of records consuming the L<GenOO::Region>
30             role.The records are stored in a database (ie MySQL, SQLite, etc) and the class offers methods
31             for quering them and accessing specific characteristics (eg. longest record). Internally the class
32             rests on DBIx::Class for the database access and for defining the appropriate result objects.
33             Note that the columns which correspond to the required attributes of L<GenOO::Region> must exist
34             in the table schema (ie. strand, rname, start, stop, copy_number)
35              
36             =head1 EXAMPLES
37              
38             # Get the records contained in a specific region
39             my @records = $region_collection->records_contained_in_region(1,'chr3',127726308,127792250);
40            
41             # Get the longest record
42             my $longest_record = $region_collection->longest_record;
43            
44             =cut
45              
46             # Let the code begin...
47              
48             package GenOO::RegionCollection::Type::DBIC;
49             $GenOO::RegionCollection::Type::DBIC::VERSION = '1.4.6';
50              
51             #######################################################################
52             ####################### Load External modules #####################
53             #######################################################################
54 1     1   5 use Modern::Perl;
  1         1  
  1         6  
55 1     1   126 use autodie;
  1         2  
  1         6  
56 1     1   3523 use Moose;
  1         1  
  1         7  
57 1     1   5745 use namespace::autoclean;
  1         1  
  1         8  
58              
59              
60             #######################################################################
61             ######################## Load GenOO modules #######################
62             #######################################################################
63 1     1   708 use GenOO::Data::DB::DBIC::Species::Schema;
  1         3  
  1         1563  
64              
65              
66             #######################################################################
67             ####################### Interface attributes ######################
68             #######################################################################
69             has 'dsn' => (
70             isa => 'Str',
71             is => 'ro',
72             );
73              
74             has 'user' => (
75             isa => 'Maybe[Str]',
76             is => 'ro'
77             );
78              
79             has 'password' => (
80             isa => 'Maybe[Str]',
81             is => 'ro'
82             );
83              
84             has 'attributes' => (
85             traits => ['Hash'],
86             is => 'ro',
87             isa => 'HashRef[Str]',
88             default => sub { {} },
89             );
90              
91             has 'table' => (
92             isa => 'Str',
93             is => 'ro',
94             );
95              
96             has 'records_class' => (
97             is => 'ro',
98             default => 'GenOO::Data::DB::DBIC::Species::Schema::SampleResultBase::v1',
99             );
100              
101             has 'name' => (
102             isa => 'Str',
103             is => 'rw'
104             );
105              
106             has 'species' => (
107             isa => 'Str',
108             is => 'rw'
109             );
110              
111             has 'description' => (
112             isa => 'Str',
113             is => 'rw'
114             );
115              
116             has 'schema' => (
117             isa => 'GenOO::Data::DB::DBIC::Species::Schema',
118             is => 'ro',
119             builder => '_init_schema',
120             init_arg => undef,
121             lazy => 1,
122             );
123              
124             has 'resultset' => (
125             is => 'rw',
126             builder => '_init_resultset',
127             init_arg => undef,
128             lazy => 1,
129             );
130              
131             has 'original_resultset' => (
132             is => 'rw',
133             builder => '_init_resultset',
134             init_arg => undef,
135             lazy => 1,
136             );
137              
138             has 'longest_record' => (
139             is => 'ro',
140             builder => '_find_longest_record',
141             clearer => '_clear_longest_record',
142             init_arg => undef,
143             lazy => 1,
144             );
145              
146             with 'GenOO::RegionCollection';
147              
148             #######################################################################
149             ######################## Interface Methods ########################
150             #######################################################################
151             sub add_record {
152 0     0 0 0 my ($self, $record) = @_;
153            
154 0         0 warn 'Method "add_record" has not been implemented yet'; # TODO
155 0         0 $self->_reset;
156             }
157              
158             sub foreach_record_do {
159 1     1 0 556 my ($self, $block) = @_;
160            
161 1         134 while (my $record = $self->resultset->next) {
162 976 50       85626 last if $block->($record) eq 'break_loop'; # break the loop if the routine returns 'break_loop'
163             }
164             }
165              
166             sub foreach_record_sorted_by_location_do {
167 0     0 0 0 my ($self, $block) = @_;
168            
169 0         0 my $rs = $self->resultset->search({}, {
170             order_by => { -asc => ['strand', 'rname', 'start']},
171             });
172 0         0 while (my $record = $rs->next) {
173 0 0       0 last if $block->($record) eq 'break_loop'; # break the loop if the routine returns 'break_loop'
174             }
175             }
176              
177             sub foreach_record_on_rname_do {
178 1     1 0 460 my ($self, $rname, $block) = @_;
179            
180 1         29 my $rs = $self->resultset->search({rname => $rname});
181 1         159 while (my $record = $rs->next) {
182 57 50       8550 last if $block->($record) eq 'break_loop'; # break the loop if the routine returns 'break_loop'
183             }
184             }
185              
186             sub records_count {
187 9     9 0 685 my ($self) = @_;
188            
189 9   50     254 return $self->resultset->count || 0;
190             }
191              
192             sub strands {
193 1     1 0 444 my ($self) = @_;
194            
195 1         30 return $self->resultset->search({},{
196             columns => [ qw/strand/ ],
197             distinct => 1
198             })->get_column('strand')->all;
199             }
200              
201             sub rnames_for_strand {
202 1     1 0 448 my ($self, $strand) = @_;
203            
204 1         31 return $self->resultset->search({
205             strand => $strand
206             },{
207             columns => [ qw/strand/ ],
208             distinct => 1
209             })->get_column('rname')->all;
210             }
211              
212             sub rnames_for_all_strands {
213 1     1 0 423 my ($self) = @_;
214            
215 1         28 return $self->resultset->search({},{
216             columns => [ qw/rname/ ],
217             distinct => 1
218             })->get_column('rname')->all;;
219             }
220              
221             sub is_empty {
222 2     2 0 823 my ($self) = @_;
223            
224 2 50       7 if ($self->records_count > 0) {
225 2         52293 return 0;
226             }
227             else {
228 0         0 return 1;
229             }
230             }
231              
232             sub is_not_empty {
233 1     1 0 19 my ($self) = @_;
234            
235 1         4 return !$self->is_empty;
236             }
237              
238             sub foreach_contained_record_do {
239 1     1 0 469 my ($self, $strand, $rname, $start, $stop, $block) = @_;
240            
241 1         32 my $rs = $self->resultset->search({
242             strand => $strand,
243             rname => $rname,
244             start => { '-between' => [$start, $stop] },
245             stop => { '-between' => [$start, $stop] },
246             });
247            
248 1         155 while (my $record = $rs->next) {
249 5 50       4778 last if $block->($record) eq 'break_loop'; # break the loop if the routine returns 'break_loop'
250             }
251             }
252              
253             sub records_contained_in_region {
254 1     1 0 451 my ($self, $strand, $rname, $start, $stop) = @_;
255            
256 1         33 return $self->resultset->search({
257             strand => $strand,
258             rname => $rname,
259             start => { '-between' => [$start, $stop] },
260             stop => { '-between' => [$start, $stop] },
261             })->all;
262             }
263              
264             sub total_copy_number_for_records_contained_in_region {
265 1     1 0 441 my ($self, $strand, $rname, $start, $stop) = @_;
266            
267 1   50     30 return $self->resultset->search({
268             strand => $strand,
269             rname => $rname,
270             start => { '-between' => [$start, $stop] },
271             stop => { '-between' => [$start, $stop] },
272             })->get_column('copy_number')->sum || 0;
273             }
274              
275             sub total_copy_number {
276 1     1 0 502 my ($self) = @_;
277            
278 1   50     31 return $self->resultset->get_column('copy_number')->sum || 0;
279             }
280              
281             sub filter_by_length {
282 1     1 0 444 my ($self, $min_length, $max_length) = @_;
283            
284 1         30 my $rs = $self->resultset->search(
285             \['(stop - start + 1) BETWEEN (?+0) AND (?+0)', [dummy => $min_length], [dummy => $max_length]]
286             );
287 1         191 $self->resultset($rs);
288             }
289              
290             sub filter_by_min_length {
291 1     1 0 503 my ($self, $min_length) = @_;
292            
293 1         29 my $rs = $self->resultset->search(
294             \['(stop - start + 1) >= (?+0)', [dummy => $min_length]]
295             );
296 1         173 $self->resultset($rs);
297             }
298              
299             sub filter_by_max_length {
300 1     1 0 509 my ($self, $max_length) = @_;
301            
302 1         31 my $rs = $self->resultset->search(
303             \['(stop - start + 1) <= (?+0)', [dummy => $max_length]]
304             );
305 1         177 $self->resultset($rs);
306             }
307              
308             sub simple_filter {
309 3     3 0 509 my ($self, $col_name, $filter) = @_;
310             # eg. $col_name=deletion, $filter='def'
311             # $col_name=alignment_length, $filter='>31'
312            
313 3         97 my $filtered_rs = $self->resultset;
314            
315 3 50       27 if ($filter eq 'def') {
    50          
    50          
316 0         0 $filtered_rs = $filtered_rs->search({$col_name => {'!=', undef}});
317             }
318             elsif ($filter eq 'undef') {
319 0         0 $filtered_rs = $filtered_rs->search({$col_name => undef});
320             }
321             elsif ($filter =~ /^([>=!<]{1,2})(.+)$/) {
322 3         8 my $symbol = $1;
323 3         4 my $value = $2;
324 3         20 $filtered_rs = $filtered_rs->search({$col_name => { $symbol => $value }});
325             }
326             else {
327 0         0 warn "Filter $filter does not fit the guidelines.";
328             }
329              
330            
331 3         1459 $self->resultset($filtered_rs);
332             }
333              
334              
335             #######################################################################
336             ######################### Private methods ##########################
337             #######################################################################
338             sub _init_schema {
339 18     18   25 my ($self) = @_;
340            
341 18         489 return GenOO::Data::DB::DBIC::Species::Schema->connect($self->dsn, $self->user, $self->password, $self->attributes);
342             }
343              
344             sub _init_resultset {
345 17     17   22 my ($self) = @_;
346            
347 17         487 return $self->schema->sample_resultset($self->records_class, $self->table);
348             }
349              
350             sub _find_longest_record {
351 1     1   2 my ($self) = @_;
352            
353 1         29 return $self->resultset->search({}, {
354             order_by => { -desc => 'stop-start+1' },
355             rows => 1,
356             })->single;
357             }
358              
359             sub _reset {
360 0     0     my ($self) = @_;
361            
362 0           $self->_clear_longest_record;
363             }
364              
365              
366             #######################################################################
367             ####################### Deprecated methods #########################
368             #######################################################################
369             sub foreach_overlapping_record_do {
370 0     0 0   my ($self, @args) = @_;
371            
372 0           warn 'Deprecated use of "foreach_overlapping_record_do".'.
373             'Probably "foreach_contained_record_do" does what you want.';
374 0           $self->foreach_contained_record_do(@args);
375             }
376              
377             sub records_overlapping_region {
378 0     0 0   my ($self, @args) = @_;
379            
380 0           warn 'Deprecated use of "records_overlapping_region".'.
381             'Probably "records_contained_in_region" does what you want.';
382 0           $self->records_contained_in_region(@args);
383             }
384              
385              
386             __PACKAGE__->meta->make_immutable;
387              
388             1;