File Coverage

blib/lib/PomBase/Chobo/ChadoData.pm
Criterion Covered Total %
statement 146 169 86.3
branch 6 12 50.0
condition 1 2 50.0
subroutine 26 31 83.8
pod 0 13 0.0
total 179 227 78.8


line stmt bran cond sub pod time code
1             package PomBase::Chobo::ChadoData;
2              
3             =head1 NAME
4              
5             PomBase::Chobo::ChadoData - Read and store cv/db data from Chado
6              
7             =head1 SYNOPSIS
8              
9             =head1 AUTHOR
10              
11             Kim Rutherford C<< >>
12              
13             =head1 BUGS
14              
15             Please report any bugs or feature requests to C.
16              
17             =head1 SUPPORT
18              
19             You can find documentation for this module with the perldoc command.
20              
21             perldoc PomBase::Chobo::ChadoData
22              
23             =over 4
24              
25             =back
26              
27             =head1 COPYRIGHT & LICENSE
28              
29             Copyright 2012 Kim Rutherford, all rights reserved.
30              
31             This program is free software; you can redistribute it and/or modify it
32             under the same terms as Perl itself.
33              
34             =head1 FUNCTIONS
35              
36             =cut
37              
38             our $VERSION = '0.039'; # VERSION
39              
40 1     1   10 use Mouse;
  1         2  
  1         15  
41              
42 1     1   367 use Carp qw(confess);
  1         3  
  1         2469  
43              
44             has dbh => (is => 'ro');
45              
46             has cv_data => (is => 'ro', init_arg => undef, lazy_build => 1);
47             has cvprop_data => (is => 'ro', init_arg => undef, lazy_build => 1);
48             has db_data => (is => 'ro', init_arg => undef, lazy_build => 1);
49              
50             has cvterm_data => (is => 'ro', init_arg => undef, lazy_build => 1);
51             has dbxref_data => (is => 'ro', init_arg => undef, lazy_build => 1);
52              
53             has cvtermsynonyms_by_cvterm_id => (is => 'rw', init_arg => undef, lazy_build => 1);
54              
55             our @cvterm_column_names = qw(cvterm_id name cv_id dbxref_id is_obsolete is_relationshiptype);
56             our @dbxref_column_names = qw(dbxref_id db_id accession);
57              
58             sub _execute
59             {
60 29     29   43 my $self = shift;
61 29         46 my $sql = shift;
62 29         37 my $proc = shift;
63              
64 29         62 my $dbh = $self->dbh();
65              
66 29         68 my $sth = $dbh->prepare($sql);
67 29         2976 my $rv = $sth->execute();
68 29 50       109 if (!$rv) {
69 0         0 die "couldn't execute() $sql: ", $dbh->errstr(), "\n";
70             }
71              
72 29         69 while (my $ref = $sth->fetchrow_hashref() ) {
73 164         3557 $proc->($ref);
74             }
75              
76 29         328 $sth->finish();
77             }
78              
79             sub _get_cv_or_db
80             {
81 28     28   49 my $self = shift;
82 28         40 my $table_name = shift;
83              
84 28         56 my $table_id_column = "${table_name}_id";
85              
86 28         43 my %by_id = ();
87 28         40 my %by_name = ();
88              
89             my $proc = sub {
90 163     163   209 my $row_ref = shift;
91              
92 163         256 my $id = $row_ref->{$table_id_column};
93 163         224 my $name = $row_ref->{name};
94              
95 163         393 my %data = (
96             $table_id_column, $id,
97             name => $name,
98             );
99              
100 163         323 $by_id{$id} = \%data;
101 163         536 $by_name{$name} = \%data;
102              
103 28         123 };
104              
105 28         95 $self->_execute("select $table_id_column, name from $table_name", $proc);
106              
107 28         303 return \%by_id, \%by_name;
108             }
109              
110             sub _build_cv_data
111             {
112 11     11   18 my $self = shift;
113              
114 11         26 my ($cvs_by_cv_id, $cvs_by_cv_name) = $self->_get_cv_or_db('cv');
115 11         73 return { by_id => $cvs_by_cv_id, by_name => $cvs_by_cv_name };
116             }
117              
118             sub _build_cvprop_data
119             {
120 1     1   15 my $self = shift;
121              
122 1         4 my %by_cv_id = ();
123              
124             my $proc = sub {
125 1     1   9 my $row_ref = shift;
126              
127 1         3 my $cv_id = $row_ref->{cv_id};
128              
129             my %data = (
130             cv_id => $cv_id,
131             type_id => $row_ref->{type_id},
132             value => $row_ref->{value}
133 1         4 );
134              
135 1         2 push @{$by_cv_id{$cv_id}}, \%data;
  1         6  
136 1         6 };
137              
138 1         10 $self->_execute("select cv_id, type_id, value from cvprop", $proc);
139              
140 1         16 return \%by_cv_id;
141             }
142              
143             sub get_cv_by_name
144             {
145 15     15 0 25 my $self = shift;
146 15         25 my $cv_name = shift;
147              
148 15         66 return $self->cv_data()->{by_name}->{$cv_name};
149             }
150              
151             sub get_cv_names
152             {
153 2     2 0 6 my $self = shift;
154              
155 2         2 return keys %{$self->cv_data()->{by_name}};
  2         12  
156             }
157              
158             sub _build_db_data
159             {
160 17     17   29 my $self = shift;
161              
162 17         35 my ($dbs_by_db_id, $dbs_by_db_name) = $self->_get_cv_or_db('db');
163 17         95 return { by_id => $dbs_by_db_id, by_name => $dbs_by_db_name, };
164             }
165              
166             sub get_db_by_name
167             {
168 10     10 0 15 my $self = shift;
169 10         13 my $db_name = shift;
170              
171 10         36 return $self->db_data()->{by_name}->{$db_name};
172             }
173              
174             sub get_db_names
175             {
176 2     2 0 5 my $self = shift;
177              
178 2         33 return keys %{$self->db_data()->{by_name}};
  2         16  
179             }
180              
181             sub _get_by_copy
182             {
183 26     26   44 my $self = shift;
184 26         37 my $table_name = shift;
185 26         37 my $column_names_ref = shift;
186 26         63 my @column_names = @$column_names_ref;
187 26         35 my $proc = shift;
188              
189 26         55 my $dbh = $self->dbh();
190              
191 26         85 my $column_names = join ',', @column_names;
192              
193 26 50       106 $dbh->do("COPY $table_name($column_names) TO STDOUT CSV")
194             or die "failed to COPY $table_name: ", $dbh->errstr, "\n";
195              
196 26         5915 my $tsv = Text::CSV->new({sep_char => ","});
197              
198 26         3232 my $line = undef;
199              
200 26         84 while ($dbh->pg_getcopydata(\$line) > 0) {
201 322         134134 chomp $line;
202 322 50       912 if ($tsv->parse($line)) {
203 322         7030 my @fields = $tsv->fields();
204 322         2628 $proc->(\@fields);
205             } else {
206 0         0 die "couldn't parse this line: $line\n";
207             }
208             }
209             }
210              
211             sub _get_cvtermsynonyms
212             {
213 0     0   0 my $self = shift;
214              
215 0         0 my $dbh = $self->dbh();
216              
217 0         0 my @column_names = qw(cvtermsynonym_id cvterm_id synonym type_id);
218              
219 0         0 my %by_cvterm_id = ();
220              
221             my $proc = sub {
222 0     0   0 my $fields_ref = shift;
223 0         0 my @fields = @$fields_ref;
224 0         0 my ($cvtermsynonym_id, $cvterm_id, $synonym, $type_id) = @fields;
225 0         0 $by_cvterm_id{$cvterm_id} = \@fields;
226 0         0 };
227              
228 0         0 $self->_get_by_copy('cvtermsynonym', \@column_names, $proc);
229              
230 0         0 return \%by_cvterm_id
231             }
232              
233             sub _make_term
234             {
235 105     105   147 my $self = shift;
236 105         140 my $cvterm_data = shift;
237 105         146 my $dbxref_data = shift;
238              
239 105         183 my $dbxref_id = $cvterm_data->[3];
240              
241 105         164 my $by_dbxref_id = $dbxref_data->{by_dbxref_id};
242 105         216 my $termid = $by_dbxref_id->{$dbxref_id}->{termid};
243              
244 105         608 return bless {
245             id => $termid,
246             cvterm_id => $cvterm_data->[0],
247             name => $cvterm_data->[1],
248             cv_id => $cvterm_data->[2],
249             dbxref_id => $dbxref_id,
250             is_obsolete => $cvterm_data->[4],
251             is_relationshiptype => $cvterm_data->[5],
252             }, 'PomBase::Chobo::OntologyTerm';
253             }
254              
255             sub _build_cvterm_data
256             {
257 11     11   21 my $self = shift;
258              
259 11         17 my %by_cvterm_id = ();
260 11         13 my %by_cv_id = ();
261 11         21 my %by_termid = ();
262              
263 11         35 my $dbxref_data = $self->dbxref_data();
264              
265             my $proc = sub {
266 105     105   164 my $fields_ref = shift;
267              
268 105         235 my $term = $self->_make_term($fields_ref, $dbxref_data);
269              
270 105         395 $by_cvterm_id{$term->cvterm_id()} = $term;
271 105         362 $by_cv_id{$term->cv_id()}->{$term->name()} = $term;
272 105         486 $by_termid{$term->id()} = $term;
273 11         68 };
274              
275 11         37 $self->_get_by_copy('cvterm', \@cvterm_column_names, $proc);
276              
277             return {
278 11         479 by_cvterm_id => \%by_cvterm_id,
279             by_cv_id => \%by_cv_id,
280             by_termid => \%by_termid,
281             };
282             }
283              
284             sub get_cvterm_by_cvterm_id
285             {
286 0     0 0 0 my $self = shift;
287              
288 0         0 return $self->cvterm_data()->{by_cvterm_id};
289             }
290              
291             sub get_cvterms_by_cv_id
292             {
293 7     7 0 13 my $self = shift;
294 7         11 my $cv_id = shift;
295              
296 7 50       16 if (!defined $cv_id) {
297 0         0 confess "undefined cv_id passed to get_cvterms_by_cv_id()";
298             }
299              
300 7         35 return $self->cvterm_data()->{by_cv_id}->{$cv_id};
301             }
302              
303             sub get_cvterm_by_termid
304             {
305 25     25 0 39 my $self = shift;
306 25         37 my $termid = shift;
307              
308 25         86 return $self->cvterm_data()->{by_termid}->{$termid};
309             }
310              
311             sub get_all_cvterms
312             {
313 2     2 0 5 my $self = shift;
314              
315 2         5 return values %{$self->cvterm_data()->{by_termid}};
  2         13  
316             }
317              
318             sub get_cvterm_by_name
319             {
320 3     3 0 6 my $self = shift;
321 3         6 my $cv_name = shift;
322 3         4 my $cvterm_name = shift;
323              
324 3         7 my $cv = $self->get_cv_by_name($cv_name);
325              
326 3         10 return $self->get_cvterms_by_cv_id($cv->{cv_id})->{$cvterm_name};
327             }
328              
329             sub get_cvprop_values
330             {
331 1     1 0 36450 my $self = shift;
332 1         3 my $cv_name = shift;
333 1         3 my $prop_type_name = shift;
334              
335 1         3 my $cv = $self->get_cv_by_name($cv_name);
336 1         9 my $cvprops = $self->cvprop_data()->{$cv->{cv_id}};
337 1         3 my $prop_type = $self->get_cvterm_by_name('cv_property_type', $prop_type_name);
338              
339             return map {
340             $_->{value}
341 1         5 }
342             grep {
343             $_->{type_id} == $prop_type->{cvterm_id}
344 1   50     2 } @{$cvprops // []};
  1         6  
  1         6  
345             }
346              
347             sub get_all_termids
348             {
349 10     10 0 19 my $self = shift;
350              
351 10         13 return keys %{$self->dbxref_data()->{by_termid}};
  10         37  
352             }
353              
354             sub get_dbxref_by_termid
355             {
356 17     17 0 38 my $self = shift;
357 17         68 my $termid = shift;
358              
359 17         61 return $self->dbxref_data()->{by_termid}->{$termid};
360             }
361              
362             sub _build_dbxref_data
363             {
364 15     15   21 my $self = shift;
365              
366 15         34 my $dbh = $self->dbh();
367              
368 15         53 my $db_data = $self->db_data();
369              
370 15         27 my %by_dbxref_id = ();
371 15         25 my %by_termid = ();
372 15         22 my %by_db_name = ();
373              
374             my $proc = sub {
375 217     217   316 my $fields_ref = shift;
376 217         498 my @fields = @$fields_ref;
377 217         484 my ($dbxref_id, $db_id, $accession, $version) = @fields;
378              
379 217         810 my %data = (dbxref_id => $dbxref_id,
380             db_id => $db_id,
381             accession => $accession,
382             version => $version);
383              
384 217         476 my $db_name = $db_data->{by_id}->{$db_id}->{name};
385 217 50       484 if (!defined $db_name) {
386 0         0 die "no db name for db $db_id";
387             }
388              
389 217         316 my $termid;
390              
391 217 50       415 if ($db_name eq '_global') {
392 0         0 $termid = $accession;
393             } else {
394 217         499 $termid = "$db_name:$accession";
395             }
396              
397 217         385 $data{termid} = $termid;
398              
399 217         463 $by_dbxref_id{$dbxref_id} = \%data;
400 217         445 $by_termid{$termid} = \%data;
401 217         1036 $by_db_name{$db_name}->{$termid} = \%data;
402 15         77 };
403              
404 15         53 $self->_get_by_copy('dbxref', \@dbxref_column_names, $proc);
405              
406             return {
407 15         661 by_dbxref_id => \%by_dbxref_id,
408             by_termid => \%by_termid,
409             by_db_name => \%by_db_name,
410             };
411             }
412              
413             sub _build_cvtermsynonyms_by_cvterm_id
414             {
415 0     0     my $self = shift;
416              
417 0           return $self->_get_cvtermsynonyms();
418             }
419              
420             sub get_cvtermsynonyms_by_cvterm_id
421             {
422 0     0 0   my $self = shift;
423 0           my $cvterm_id = shift;
424              
425 0           return $self->cvtermsynonyms_by_cvterm_id()->{$cvterm_id};
426             }
427              
428             1;