File Coverage

blib/lib/PomBase/Chobo/ParseOBO.pm
Criterion Covered Total %
statement 105 122 86.0
branch 46 60 76.6
condition 14 20 70.0
subroutine 5 7 71.4
pod 0 3 0.0
total 170 212 80.1


line stmt bran cond sub pod time code
1             package PomBase::Chobo::ParseOBO;
2              
3             =head1 NAME
4              
5             PomBase::Chobo::ParseOBO - Parse the bits of an OBO file needed for
6             loading Chado
7              
8             =head1 SYNOPSIS
9              
10             =head1 AUTHOR
11              
12             Kim Rutherford C<< >>
13              
14             =head1 BUGS
15              
16             Please report any bugs or feature requests to C.
17              
18             =head1 SUPPORT
19              
20             You can find documentation for this module with the perldoc command.
21              
22             perldoc PomBase::Chobo::ParseOBO
23              
24             =over 4
25              
26             =back
27              
28             =head1 COPYRIGHT & LICENSE
29              
30             Copyright 2012 Kim Rutherford, all rights reserved.
31              
32             This program is free software; you can redistribute it and/or modify it
33             under the same terms as Perl itself.
34              
35             =head1 FUNCTIONS
36              
37             =cut
38              
39             our $VERSION = '0.038'; # VERSION
40              
41 4     4   245933 use Mouse;
  4         84991  
  4         25  
42 4     4   3512 use FileHandle;
  4         32902  
  4         22  
43              
44 4     4   3054 use PomBase::Chobo::OntologyData;
  4         16  
  4         6164  
45              
46             sub die_line
47             {
48 0     0 0 0 my $filename = shift;
49 0         0 my $linenum = shift;
50 0         0 my $message = shift;
51              
52 0         0 die "$filename:$linenum:$message\n";
53             }
54              
55             sub _finish_stanza
56             {
57 72     72   116 my $filename = shift;
58 72         107 my $current = shift;
59 72         91 my $terms_ref = shift;
60 72         100 my $metadata_ref = shift;
61              
62 72 50 66     182 if ($current->{is_obsolete} && $current->{is_relationshiptype}) {
63 0         0 return;
64             }
65              
66 72 50       176 if (!defined $current->{id}) {
67 0         0 die_line $filename, $current->{line}, "stanza has no id\n";
68 0         0 return;
69             }
70              
71 72 100       158 if ($current->{is_obsolete}) {
72 4         10 delete $current->{alt_id};
73             }
74              
75 72         139 $current->{metadata} = $metadata_ref;
76 72         145 $current->{source_file} = $filename;
77 72   100     349 $current->{relationship} //= [];
78              
79 72         122 my $namespace_from_metadata = 0;
80              
81 72 100       156 if (!defined $current->{namespace}) {
82             $current->{namespace} =
83             $metadata_ref->{'default-namespace'} //
84             $metadata_ref->{'ontology'} //
85 34   66     131 $current->{source_file} . '::' . $current->{id} =~ s/:.*//r;
      33        
86              
87 34 100       79 if ($current->{namespace} eq 'ro') {
88 4         7 $current->{namespace} = 'relations';
89             }
90              
91 34         57 $namespace_from_metadata = 1;
92             }
93              
94 72 100       143 if ($current->{is_a}) {
95             map {
96 54         71 push @{$current->{relationship}},
  54         224  
97             {
98             'relationship_name' => 'is_a',
99             'other_term' => $_,
100             };
101 47         79 } @{$current->{is_a}};
  47         118  
102              
103 47         107 delete $current->{is_a};
104             }
105              
106 72 100       160 if ($current->{synonym}) {
107 35         72 my %seen_synonyms = ();
108              
109             $current->{synonym} = [
110             map {
111              
112 60         124 my $seen_synonym = $seen_synonyms{$_->{synonym}};
113 60 100 66     153 if ($seen_synonym && lc $seen_synonym->{scope} eq 'exact') {
114             # keep it
115             } else {
116 58         204 $seen_synonyms{$_->{synonym}} = $_;
117             }
118 35         50 } @{$current->{synonym}}
  35         84  
119             ];
120              
121 35         192 $current->{synonym} = [sort { $a->{synonym} cmp $b->{synonym} } values %seen_synonyms];
  33         89  
122             }
123              
124 72         175 my $options = { namespace_from_metadata => $namespace_from_metadata };
125              
126 72         289 my $new_term = PomBase::Chobo::OntologyTerm->make_object($current, $options);
127              
128 72         234 push @$terms_ref, $new_term;
129             }
130              
131             sub fatal
132             {
133 0     0 0 0 my $message = shift;
134              
135 0         0 die "fatal: $message\n";
136             }
137              
138             my %interesting_metadata = (
139             'default-namespace' => 1,
140             'ontology' => 1,
141             'date' => 1,
142             'data-version' => 1,
143             );
144              
145             sub parse
146             {
147 11     11 0 1792 my $self = shift;
148 11         48 my %args = @_;
149              
150 11         25 my $filename = $args{filename};
151 11 50       37 if (!defined $filename) {
152 0         0 die 'no filename passed to parse()';
153             }
154              
155 11         21 my $ontology_data = $args{ontology_data};
156 11 50       31 if (!defined $ontology_data) {
157 0         0 die 'no ontology_data passed to parse()';
158             }
159              
160 11         24 my %metadata = ();
161 11         23 my @terms = ();
162              
163 11         15 my $current = undef;
164 11         22 my @synonyms = ();
165              
166 11         18 my %meta = ();
167              
168 11 50       535 open my $fh, '<:utf8', $filename or die "can't open $filename: $!";
169              
170 11         41 my $line_number = 0;;
171              
172 11         384 while (defined (my $line = <$fh>)) {
173 819         1212 $line_number++;
174 819         1178 chomp $line;
175 819         1800 $line =~ s/![^"\n]*$//;
176 819         2443 $line =~ s/\s+$//;
177 819         1430 $line =~ s/^\s+//;
178              
179 819 100       2071 next if length $line == 0;
180              
181 745 100       1594 if ($line =~ /^\[(.*)\]$/) {
182 72         172 my $stanza_type = $1;
183              
184 72 100       151 if (defined $current) {
185 61         169 _finish_stanza($filename, $current, \@terms, \%metadata);
186             }
187              
188 72         114 my $is_relationshiptype = 0;
189              
190 72 100       175 if ($stanza_type eq 'Typedef') {
191 10         15 $is_relationshiptype = 1;
192             } else {
193 62 50       136 if ($stanza_type ne 'Term') {
194 0         0 die "unknown stanza type '[$stanza_type]'\n";
195             }
196             }
197 72         340 $current = {
198             is_relationshiptype => $is_relationshiptype,
199             source_file_line_number => $line_number,
200             };
201             } else {
202 673 100       1050 if ($current) {
203 576         1574 my @bits = split /: /, $line, 2;
204 576 50       1372 if (@bits == 2) {
205 576         902 my $field_name = $bits[0];
206 576         736 my $field_value = $bits[1];
207              
208             # ignored for now
209 576         705 my $modifier_string;
210              
211 576 100       1138 if ($field_value =~ /\}$/) {
212 2         18 $field_value =~ s/(.*)\{(.*)\}$/$1/;
213 2         5 $modifier_string = $2;
214 2         13 $field_value =~ s/\s+$//;
215             }
216              
217 576         1167 my $field_conf = $PomBase::Chobo::OntologyConf::field_conf{$field_name};
218              
219 576 100       1330 if (defined $field_conf) {
220 430 100       832 if (defined $field_conf->{process}) {
221 201         316 eval {
222 201         522 $field_value = $field_conf->{process}->($field_value);
223             };
224 201 50       433 if ($@) {
225 0         0 warn qq(warning "$@" at $filename line $.\n);
226             }
227             }
228 430 50       766 if (defined $field_value) {
229 430 100 100     1652 if (defined $field_conf->{type} &&
      66        
230             ($field_conf->{type} eq 'SINGLE' || $field_conf->{type} eq 'SINGLE_HASH')) {
231 260         1364 $current->{$field_name} = $field_value;
232             } else {
233 170         223 push @{$current->{$field_name}}, $field_value;
  170         1077  
234             }
235             }
236             }
237             } else {
238 0         0 die "can't parse line - no colon: $line\n";
239             }
240             } else {
241             # we're parsing metadata
242 97 50       324 if ($line =~ /^(.+?):\s*(.*)/) {
243 97         293 my ($key, $value) = ($1, $2);
244              
245 97 100       412 if ($interesting_metadata{$key}) {
246 34 50       83 if (defined $metadata{$key}) {
247 0         0 warn qq(metadata key "$key" occurs more than once in header\n);
248             } else {
249 34         141 $metadata{$key} = $value;
250             }
251             }
252             } else {
253 0         0 fatal "can't parse header line: $line";
254             }
255             }
256             }
257             }
258              
259 11 50       66 if (defined $current) {
260 11         61 _finish_stanza($filename, $current, \@terms, \%metadata);
261             }
262              
263 11 50       172 close $fh or die "can't close $filename: $!";
264              
265 11         31 eval {
266 11         60 $ontology_data->add(metadata => \%metadata,
267             terms => \@terms);
268             };
269 11 50       143 if ($@) {
270 0           die "failed while reading $filename: $@\n";
271             }
272             }
273              
274             1;