[Bio] / FigKernelPackages / SwissProtUtils.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/SwissProtUtils.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download) (as text)

1 : golsen 1.1 package SwissProtUtils;
2 :    
3 :     use strict;
4 :     use File::Temp;
5 :     use XML::Simple;
6 :     use JSON::XS;
7 :     use Digest::MD5;
8 :     use Data::Dumper;
9 :    
10 :     #-------------------------------------------------------------------------------
11 :     # Read the Swiss-Prot XML format distribution file, producing a file with
12 :     # a one-line JSON conversion.
13 :     #
14 :     # XML_to_JSON( $in_file, $out_file, \%options )
15 :     # XML_to_JSON( $in_file, \%options )
16 :     # XML_to_JSON( \%options )
17 :     #
18 :     # $in_file can be a file name, open file handle or string reference, defining
19 :     # the source of the XML. If undefined or an empty string, input is from
20 :     # STDIN.
21 :     #
22 :     # $out_file can be a file name, open file handle or string reference, defining
23 :     # the destination for the JSON. If undefined or an empty string, output
24 :     # is to STDOUT.
25 :     #
26 :     # Options:
27 :     #
28 :     # condensed => $bool # If true, do not invoke 'pretty'
29 :     # loadfile => $bool # Forces 1-line output of:
30 :     # # acc, id, md5, function, org, taxid, json
31 :     # pretty => $bool # If explicitly false, do not invoke 'pretty'
32 :     # processes => $int # Number of parallel processes to spawn
33 :     #
34 :     # subset => [$i,$n] # Process the $i'th segment of $n segments in the
35 :     # # input file (this should not be invoked by
36 :     # # the user).
37 :     #
38 :     # Note: The load file option is generally not recommend if one will also
39 :     # want the JSON format by itself. Conversion to JSON followed by
40 :     # a separate conversion to the load file is almost as fast, and is
41 :     # almost twice as fast as producing the two conversions separately.
42 :     #-------------------------------------------------------------------------------
43 :     # Get next entry as a perl structure, or undef on EOF or error. Partial
44 :     # initial or final entries are discarded. Also, fix perl structure
45 :     # format inconsistencies, and add the sequence md5.
46 :     #
47 :     # $entry = next_XML_entry( \*FH, \%opts )
48 :     # $entry = next_XML_entry( \*FH )
49 :     # $entry = next_XML_entry( \%opts ) # STDIN
50 :     # $entry = next_XML_entry() # STDIN
51 :     #
52 :     # Options:
53 :     #
54 :     # max_read => $offset # Maximum file offset for starting a new entry
55 :     #
56 :     #-------------------------------------------------------------------------------
57 :     # Take the XML version of Swiss-Prot (or Uni-Prot) and convert to a
58 :     # SEEDtk loadfile with:
59 :     #
60 :     # acc, id, md5, function, org, taxid, json
61 :     #
62 :     # $record_cnt = XML_to_loadfile( $XML_infile, $loadfile )
63 :     #
64 :     # Files can be supplied as filename, filehandle, or string reference.
65 :     # Files default to STDIN and STDOUT.
66 :     #
67 :     # Options: Currently there are no options, but an options hash will be
68 :     # passed through, if provided.
69 :     #
70 :     # The vast majority of the time is spent in the XML to JSON conversion.
71 :     # So, it having the JSON format file is of interest, do that conversion
72 :     # first, saving the results to a file, and then use JSON_to_loadfile.
73 :     #-------------------------------------------------------------------------------
74 :     # Read a file of JSON entries one at a time. Returns undef at the end of the
75 :     # file. The routine assumes that the JSON text is all on one line. The
76 :     # JSON::XS object used for decoding is cached in the options hash, but should
77 :     # not be set by the user unless they must use an unusual character coding.
78 :     #
79 :     # $entry = next_JSON_entry( \*FH, \%opts )
80 :     # $entry = next_JSON_entry( \*FH )
81 :     # $entry = next_JSON_entry( \%opts ) # STDIN
82 :     # $entry = next_JSON_entry() # STDIN
83 :     #
84 :     # Options:
85 :     #
86 :     # json => $jsonObject
87 :     #
88 :     #-------------------------------------------------------------------------------
89 :     # Read the output of XML to JSON, and create a loadfile.
90 :     # This assumes that the JSON text is all on one line.
91 :     #
92 :     # JSON_to_loadfile( $infile, $outfile, \%opts )
93 :     # JSON_to_loadfile( $infile, $outfile )
94 :     # JSON_to_loadfile( $infile, \%opts ) # STDOUT
95 :     # JSON_to_loadfile( $infile ) # STDOUT
96 :     # JSON_to_loadfile( \%opts ) # STDIN, STDOUT
97 :     # JSON_to_loadfile() # STDIN, STDOUT
98 :     #
99 :     # Options:
100 :     #
101 :     # infile => $in_file
102 :     # infile => \*in_fh
103 :     # infile => \$in_str
104 :     # outfile => $out_file
105 :     # outfile => \*out_fh
106 :     # outfile => \$out_str
107 :     #
108 :     # Positional parameters take precedence over options.
109 :     #-------------------------------------------------------------------------------
110 :     # The internal function that sets the load file items, deriving them from the
111 :     # Swiss-Prot entry.
112 :     #
113 :     # ( $acc, $id, $md5, $def, $org, $taxid ) = loadfile_items( $sp_entry )
114 :     #
115 :     #===============================================================================
116 :     # Accessing data from a Swiss-Prot entry; this is a work in progress.
117 :     # Several access functions behave slightly differently in scalar context.
118 :     #-------------------------------------------------------------------------------
119 :     # Top level entry data:
120 :     #
121 :     # $creation_date = created( $entry ) # YYYY-MM-DD
122 :     # $modif_date = modified( $entry ) # YYYY-MM-DD
123 :     # $version = version( $entry )
124 :     # $keyword = dataset( $entry ) # Swiss-Prot | TREMBL
125 :     #
126 :     # These are attributes on the entry element, and are put on the ID line of the
127 :     # flat file.
128 :     #-------------------------------------------------------------------------------
129 :     # Accession data
130 :     #
131 :     # @acc = accession( $entry )
132 :     # $acc = accession( $entry ) # Just the first one
133 :     #-------------------------------------------------------------------------------
134 :     # Protein name data.
135 :     #
136 :     # $id = id( $entry )
137 :     # $id = name( $entry )
138 :     #
139 :     # This is on the ID line of the flat file, and the name element in the XML.
140 :     # It is never repeated, though the XML spec says that it can be.
141 :     #-------------------------------------------------------------------------------
142 :     # Protein name/function data
143 :     #
144 :     # $full_recommend = assignment( $entry );
145 :     #
146 :     # ( [ $category, $type, $name, $evidence, $status, $qualif ], ... ) = assignments( $entry )
147 :     #
148 :     # $category is one of: recommened | alternative | submitted
149 :     # $type is one of: full | short | EC
150 :     # $qualif is one of: '' | domain | contains
151 :     #
152 :     # where:
153 :     #
154 :     # domain describes a protein domain
155 :     # contains describes a product of protein processing
156 :     #
157 :     #-------------------------------------------------------------------------------
158 :     # Gene data
159 :     #
160 :     # ( [ $gene, $type ], ... ) = gene( $entry );
161 :     # $gene = gene( $entry );
162 :     #
163 :     # $type is one of: primary | synonym | 'ordered locus' | ORF
164 :     #
165 :     # Direct access to locus tags ('ordered locus'):
166 :     #
167 :     # $tag = locus_tag( $entry );
168 :     # @tags = locus_tag( $entry );
169 :     #-------------------------------------------------------------------------------
170 :     # Organism data:
171 :     #
172 :     # ( [ $name, $type ], ... ) = organism( $entry );
173 :     # $name = organism( $entry );
174 :     #
175 :     # $type is one of: scientific | common | synonym | full | abbreviation
176 :     #
177 :     #-------------------------------------------------------------------------------
178 :     # Taxonomy dat:
179 :     #
180 :     # @taxa = taxonomy( $entry ); # List of taxa
181 :     # \@taxa = taxonomy( $entry ); # Reference to list of taxa
182 :     #
183 :     #-------------------------------------------------------------------------------
184 :     # Host organism data:
185 :     #
186 :     # @hosts = host( $entry ) # List of hosts
187 :     # $host = host( $entry ) # First host
188 :     #
189 :     # Each host is [ $scientific_name, $common_name, $NCBI_taxid ]
190 :     #-------------------------------------------------------------------------------
191 :     # Gene location data
192 :     #
193 :     # @gene_loc = gene_loc( $entry )
194 :     # \@gene_loc = gene_loc( $entry )
195 :     #
196 :     # $gene_loc is a string with either compartment, or a "compartment: element_name"
197 :     #-------------------------------------------------------------------------------
198 :     # Reference data:
199 :     #
200 :     # @references = references( $entry )
201 :     #
202 :     # Each reference is a hash of key value pairs, which vary with the reference
203 :     # type.
204 :     #-------------------------------------------------------------------------------
205 :     # Comment data:
206 :     #
207 :     # Comments come in specific types, with very few shared attributes or
208 :     # elements. Thus, nearly all access routines are type specific, but
209 :     # even then, they are clumsy.
210 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
211 :     # Top-level access returns unmodified elements.
212 :     #
213 :     # @typed_comments = comments( $entry )
214 :     # /@typed_comments = comments( $entry )
215 :     #
216 :     # where:
217 :     #
218 :     # $typed_comment = [ $type, $comment_element ];
219 :     #
220 :     # Direct extractor for particular comment type in an entry
221 :     #
222 :     # @comment_elements_of_type = comments_of_type( $entry, $type )
223 :     #
224 :     # $comment_elements = comment_elements( $entry );
225 :     # @comment_elements_of_type = filter_comments( $comment_elements, $type );
226 :     #
227 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
228 :     # Comment data for individual types (or subtypes):
229 :     # All comments can have an evidence attribute.
230 :     #
231 :     # <xs:attribute name="evidence" type="intListType" use="optional"/>
232 :     #
233 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
234 :     # absorbtion
235 :     #
236 :     # ( [ $data_type, $text, $evidence, $status ], ... ) = absorption( $entry );
237 :     # [ [ $data_type, $text, $evidence, $status ], ... ] = absorption( $entry );
238 :     #
239 :     # $data_type is max or note.
240 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
241 :     # allergen:
242 :     #
243 :     # ( $text_evid_stat, ... ) = allergen( $entry );
244 :     # [ $text_evid_stat, ... ] = allergen( $entry );
245 :     #
246 :     # $text_evid_stat = [ $text, $evidence, $status ]
247 :     #
248 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
249 :     # alternative products:
250 :     #
251 :     # ( [ \@events, \@isoforms, \@text_evid_stat ], ... ) = alt_product( $entry )
252 :     # [ [ \@events, \@isoforms, \@text_evid_stat ], ... ] = alt_product( $entry )
253 :     #
254 :     # @events is one or more of: alternative initiation | alternative promoter
255 :     # | alternative splicing | ribosomal frameshifting
256 :     #
257 :     # @isoforms = ( [ $id, $name, $type, $ref, \@text_evid_stat ], ... )
258 :     #
259 :     # $id is a string of the form $acc-\d+, providing an identifier for
260 :     # each isoform, based on the accession number. $acc-1 is the
261 :     # sequence displayed in the entry.
262 :     #
263 :     # $name is a name from the literature, or the index number from the id.
264 :     #
265 :     # $type is one or more of: displayed | described | external | not described
266 :     #
267 :     # $ref is a string with zero or more feature ids defining the variant.
268 :     #
269 :     # @text_evid_stat is ( [ $note, $evidence, $status ], ... )
270 :     #
271 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
272 :     # biotechnology:
273 :     #
274 :     # ( $text_evid_stat, ... ) = biotechnology( $entry );
275 :     # [ $text_evid_stat, ... ] = biotechnology( $entry );
276 :     #
277 :     # $text_evid_stat = [ $text, $evidence, $status ]
278 :     #
279 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
280 :     # catalytic activity:
281 :     #
282 :     # ( $text_evid_stat, ... ) = catalytic_activity( $entry );
283 :     # [ $text_evid_stat, ... ] = catalytic_activity( $entry );
284 :     #
285 :     # $text_evid_stat = [ $text, $evidence, $status ]
286 :     #
287 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
288 :     # caution:
289 :     #
290 :     # ( $text_evid_stat, ... ) = caution( $entry );
291 :     # [ $text_evid_stat, ... ] = caution( $entry );
292 :     #
293 :     # $text_evid_stat = [ $text, $evidence, $status ]
294 :     #
295 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
296 :     # cofactor:
297 :     #
298 :     # ( [ \@cofactors, $text_evid_stat, $molecule ], ... ) = cofactor( $entry )
299 :     # [ [ \@cofactors, $text_evid_stat, $molecule ], ... ] = cofactor( $entry )
300 :     #
301 :     # @cofactors = ( [ $name, $xref_db, $xref_id, $evidence ], ... )
302 :     # $text_evid_stat = [ $text, $evidence, $status ]
303 :     # $evidence is a string of keys to evidence elements in the entry.
304 :     # $status is a qualifier indicating projection or uncertainty.
305 :     #
306 :     # There is no obvious consistency in terms of lumping all cofactors into one
307 :     # cofactor comment with multiple cofactors, or distributing them among
308 :     # multiple comments.
309 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
310 :     # developmental stage:
311 :     #
312 :     # ( $text_evid_stat, ... ) = developmental_stage( $entry );
313 :     # [ $text_evid_stat, ... ] = developmental_stage( $entry );
314 :     #
315 :     # $text_evid_stat = [ $text, $evidence, $status ]
316 :     #
317 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
318 :     # disease:
319 :     #
320 :     # ( [ $id, $name, $acronym, $desc, \@xref, $text_evid_stat, $evidence ], ... ] = disease( $entry );
321 :     # [ [ $id, $name, $acronym, $desc, \@xref, $text_evid_stat, $evidence ], ... ] = disease( $entry );
322 :     #
323 :     # @xref = ( [ $db, $id ], ... )
324 :     # $text_evid_stat = [ $text, $evidence, $status ]
325 :     #
326 :     # The first 5 fields are formally tied to a disease; the 6th and 7th are
327 :     # more flexible.
328 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
329 :     # disruption phenotype:
330 :     #
331 :     # ( $text_evid_stat, ... ) = disruption_phenotype( $entry );
332 :     # [ $text_evid_stat, ... ] = disruption_phenotype( $entry );
333 :     #
334 :     # $text_evid_stat = [ $text, $evidence, $status ]
335 :     #
336 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
337 :     # domain (these are domains in the protein structure)
338 :     #
339 :     # ( $text_evid_stat, ... ) = domain( $entry );
340 :     # [ $text_evid_stat, ... ] = domain( $entry );
341 :     #
342 :     # $text_evid_stat = [ $text, $evidence, $status ]
343 :     #
344 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
345 :     # enzyme regulation:
346 :     #
347 :     # ( $text_evid_stat, ... ) = enzyme_regulation( $entry );
348 :     # [ $text_evid_stat, ... ] = enzyme_regulation( $entry );
349 :     #
350 :     # $text_evid_stat = [ $text, $evidence, $status ]
351 :     #
352 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
353 :     # function:
354 :     #
355 :     # ( $text_evid_stat, ... ) = function_comment( $entry );
356 :     # [ $text_evid_stat, ... ] = function_comment( $entry );
357 :     #
358 :     # $text_evid_stat = [ $text, $evidence, $status ]
359 :     #
360 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
361 :     # induction:
362 :     #
363 :     # ( $text_evid_stat, ... ) = induction( $entry );
364 :     # [ $text_evid_stat, ... ] = induction( $entry );
365 :     #
366 :     # $text_evid_stat = [ $text, $evidence, $status ]
367 :     #
368 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
369 :     # interaction:
370 :     #
371 :     # ( [ \@interactants, $orgs_differ, $n_exper ], ... ) = interaction( $entry )
372 :     # [ [ \@interactants, $orgs_differ, $n_exper ], ... ] = interaction( $entry )
373 :     #
374 :     # @interactants = ( [ $intactId, $sp_acc, $label ], ... )
375 :     # $intactId is an EBI identifier
376 :     # $sp_acc is the Swiss-Prot accession number (when available)
377 :     # $label is a protein identifier, mostly in genetic nomenclature
378 :     # $orgs_differ is a boolean value that indicates heterologous species
379 :     # $n_exper is the number of experiments supporting the interaction
380 :     #
381 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
382 :     # kinetics:
383 :     #
384 :     # ( [ $measurement, $text, $evidence, $status ], ... ) = kinetics( $entry )
385 :     # [ [ $measurement, $text, $evidence, $status ], ... ] = kinetics( $entry )
386 :     #
387 :     # Measurement is 1 of: KM | Vmax | note
388 :     #
389 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
390 :     # mass spectrometry:
391 :     #
392 :     # ( [ $mass, $error, $method, $evidence, \@text_evid_stat ], ... ) = mass_spectrometry( $entry )
393 :     # [ [ $mass, $error, $method, $evidence, \@text_evid_stat ], ... ] = mass_spectrometry( $entry )
394 :     #
395 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
396 :     # miscellaneous:
397 :     #
398 :     # ( $text_evid_stat, ... ) = misc_comment( $entry );
399 :     # [ $text_evid_stat, ... ] = misc_comment( $entry );
400 :     #
401 :     # $text_evid_stat = [ $text, $evidence, $status ]
402 :     #
403 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
404 :     # online information:
405 :     #
406 :     # ( [ $name, $url, \@text_evid_stat ], ... ) = online_info( $entry );
407 :     # [ [ $name, $url, \@text_evid_stat ], ... ] = online_info( $entry );
408 :     #
409 :     # @text_evid_stat = ( [ $text, $evidence, $status ], ... )
410 :     #
411 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
412 :     # pathway:
413 :     #
414 :     # ( $text_evid_stat, ... ) = pathway( $entry );
415 :     # [ $text_evid_stat, ... ] = pathway( $entry );
416 :     #
417 :     # $text_evid_stat = [ $text, $evidence, $status ]
418 :     #
419 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
420 :     # pharmaceutical:
421 :     #
422 :     # ( $text_evid_stat, ... ) = pharmaceutical( $entry );
423 :     # [ $text_evid_stat, ... ] = pharmaceutical( $entry );
424 :     #
425 :     # $text_evid_stat = [ $text, $evidence, $status ]
426 :     #
427 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
428 :     # pH_dependence:
429 :     #
430 :     # ( $text_evid_stat, ... ) = pH_dependence( $entry );
431 :     # [ $text_evid_stat, ... ] = pH_dependence( $entry );
432 :     #
433 :     # $text_evid_stat = [ $text, $evidence, $status ]
434 :     #
435 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
436 :     # polymorphism:
437 :     #
438 :     # ( $text_evid_stat, ... ) = polymorphism( $entry );
439 :     # [ $text_evid_stat, ... ] = polymorphism( $entry );
440 :     #
441 :     # $text_evid_stat = [ $text, $evidence, $status ]
442 :     #
443 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
444 :     # PTM (post translational modification)
445 :     #
446 :     # ( $text_evid_stat, ... ) = PTM( $entry );
447 :     # [ $text_evid_stat, ... ] = PTM( $entry );
448 :     #
449 :     # $text_evid_stat = [ $text, $evidence, $status ]
450 :     #
451 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
452 :     # redox_potential:
453 :     #
454 :     # ( $text_evid_stat, ... ) = redox_potential( $entry );
455 :     # [ $text_evid_stat, ... ] = redox_potential( $entry );
456 :     #
457 :     # $text_evid_stat = [ $text, $evidence, $status ]
458 :     #
459 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
460 :     # RNA editing:
461 :     #
462 :     # ( $loc_text_evid_stat, ... ) = RNA_editing( $entry );
463 :     # [ $loc_text_evid_stat, ... ] = RNA_editing( $entry );
464 :     #
465 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
466 :     # sequence caution:
467 :     #
468 :     # ( [ $type, $db, $id, $version, $loc, \@text_evid_stat, $evidence ], ... ) = sequence_caution( $entry )
469 :     # [ [ $type, $db, $id, $version, $loc, \@text_evid_stat, $evidence ], ... ] = sequence_caution( $entry )
470 :     #
471 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
472 :     # similarity:
473 :     #
474 :     # ( $text_evid_stat, ... ) = similarity( $entry );
475 :     # [ $text_evid_stat, ... ] = similarity( $entry );
476 :     #
477 :     # $text_evid_stat = [ $text, $evidence, $status ]
478 :     #
479 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
480 :     # subcellular location:
481 :     #
482 :     # ( [ $loc, $loc_ev, $top, $top_ev, $ori, $ori_ev, \@notes, $molecule ], ... ) = subcellular_loc( $entry )
483 :     #
484 :     # $loc = location description
485 :     # $loc_ev = list of evidence items supporting this location
486 :     # $top = topology of the protein
487 :     # $top_ev = list of evidence items supporting this topology
488 :     # $ori = orientation of the protein
489 :     # $ori_ev = list of evidence items supporting this orientation
490 :     # @notes = ( [ $note, $evidence, $status ], ... )
491 :     # $molecule is sometimes an isoform, but is often a random factoid
492 :     #
493 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
494 :     # subunit:
495 :     #
496 :     # ( $text_evid_stat, ... ) = subunit( $entry );
497 :     # [ $text_evid_stat, ... ] = subunit( $entry );
498 :     #
499 :     # $text_evid_stat = [ $text, $evidence, $status ]
500 :     #
501 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
502 :     # temp_dependence:
503 :     #
504 :     # ( $text_evid_stat, ... ) = subunit( $entry );
505 :     # [ $text_evid_stat, ... ] = subunit( $entry );
506 :     #
507 :     # $text_evid_stat = [ $text, $evidence, $status ]
508 :     #
509 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
510 :     # tissue specificity:
511 :     #
512 :     # ( $text_evid_stat, ... ) = tissue_specificity( $entry );
513 :     # [ $text_evid_stat, ... ] = tissue_specificity( $entry );
514 :     #
515 :     # $text_evid_stat = [ $text, $evidence, $status ]
516 :     #
517 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
518 :     # toxic dose:
519 :     #
520 :     # ( $text_evid_stat, ... ) = toxic_dose( $entry );
521 :     # [ $text_evid_stat, ... ] = toxic_dose( $entry );
522 :     #
523 :     # $text_evid_stat = [ $text, $evidence, $status ]
524 :     #
525 :     #-------------------------------------------------------------------------------
526 :     # Protein existence data:
527 :     #
528 :     # $keyword = existence_ev( $entry )
529 :     #
530 :     # $keyword is one of: evidence at protein level | evidence at transcript level
531 :     # | inferred from homology | predicted | uncertain
532 :     #
533 :     #-------------------------------------------------------------------------------
534 :     # Keyword data:
535 :     #
536 :     # @keywords = keywords( $entry )
537 :     # $keywords = keywords( $entry )
538 :     #
539 :     # ( [ $id, $keyword ], ... ) = id_keywords( $entry )
540 :     # $id_keywords = id_keywords( $entry )
541 :     #
542 :     # The scalar forms give a semicolon delimited list.
543 :     #-------------------------------------------------------------------------------
544 :     # Feature data
545 :     #
546 :     # ( [ $type, $loc, $description, $id, $status, $evidence, $ref ], ... ) = features( $entry );
547 :     # [ [ $type, $loc, $description, $id, $status, $evidence, $ref ], ... ] = features( $entry );
548 :     #
549 :     # $type = feature type
550 :     # $loc = [ $begin, $end, $sequence ]
551 :     # $sequence = literal sequence, when an amino acid range does not apply
552 :     # $description = text description of the feature
553 :     # $id = a feature id
554 :     # $status = keyword: by similarity | probable | potential
555 :     # $evidence = space separated list of evidence items that apply
556 :     # $ref = space separated list of reference numbers that apply
557 :     #
558 :     #-------------------------------------------------------------------------------
559 :     # Evidence associated data
560 :     #
561 :     # ( [ $key, $type, \@ref, \@xref ], ... ) = evidence( $entry )
562 :     #
563 :     # $key is the index used in evidenced strings, and other similar entries.
564 :     # $type is an EOO evidence code
565 :     # \@ref is a list of reference numbers in the entry reference list
566 :     # \@xref is a list of database cross references
567 :     #
568 :     # Observation: many of the $ref entry numbers are out of range, suggesting
569 :     # that there might be a merged reference list somewhere.
570 :     #-------------------------------------------------------------------------------
571 :     # Sequence associated data
572 :     #
573 :     # $sequence = sequence( $entry );
574 :     # $length = length( $entry );
575 :     # $md5 = md5( $entry ); # base 64 md5 of uc sequence
576 :     # $mass = mass( $entry );
577 :     # $checksum = checksum( $entry );
578 :     # $seqmoddate = seqmoddate( $entry ); # date of last sequence change
579 :     # $seqversion = seqversion( $entry ); # version of sequence (not entry)
580 :     # $fragment = fragment( $entry ); # single | multiple
581 :     # $precursor = precursor( $entry ); # boolean
582 :     #
583 :     #-------------------------------------------------------------------------------
584 :    
585 :    
586 :    
587 :     my $junk = <<'End_of_Notes';
588 :    
589 :     head -n 1474 < uniprot_sprot.xml > uniprot_sprot.10.xml
590 :     head -n 302676 < uniprot_sprot.xml > uniprot_sprot.1000.xml
591 :    
592 :     perl -e 'use XML::Simple; use Data::Dumper; print Dumper( XMLin("uniprot_sprot.10.xml", ForceArray => 1, KeyAttr => [] ) )'
593 :    
594 :     perl -e 'use SwissProtUtils; SwissProtUtils::XML_to_JSON( "uniprot_sprot.10.xml", {} )' > uniprot_sprot.10.pretty.json
595 :    
596 :     perl -e 'use SwissProtUtils; SwissProtUtils::XML_to_JSON( "uniprot_sprot.10.xml", { pretty => 1 } )' > uniprot_sprot.10.pretty.json
597 :    
598 :     perl -e 'use SwissProtUtils; SwissProtUtils::XML_to_JSON( "uniprot_sprot.10.xml", { loadfile => 1 } )' > uniprot_sprot.10.loadfile
599 :    
600 :     perl -e 'use SwissProtUtils; SwissProtUtils::XML_to_JSON( "uniprot_sprot.10.xml" )' > uniprot_sprot.10.json
601 :    
602 :     time perl -e 'use SwissProtUtils; SwissProtUtils::XML_to_JSON( "uniprot_sprot.xml" )' > uniprot_sprot.json
603 :    
604 :     head -n 10 < uniprot_sprot.json > uniprot_sprot.10.json
605 :     head -n 1000 < uniprot_sprot.json > uniprot_sprot.1000.json
606 :     head -n 100000 < uniprot_sprot.json > uniprot_sprot.100000.json
607 :    
608 :     # Get a summary of the whole file
609 :    
610 :     perl -e 'use SwissProtUtils; SwissProtUtils::report_sp_struct()' < uniprot_sprot.json > uniprot_sprot.struct.report
611 :    
612 :     # Work on the parallel version
613 :    
614 :     time perl -e 'use SwissProtUtils; SwissProtUtils::XML_to_JSON( "uniprot_sprot.1000.xml" )' > uniprot_sprot.1000.1.json
615 :     time perl -e 'use SwissProtUtils; SwissProtUtils::XML_to_JSON( "uniprot_sprot.1000.xml", { processes => 8 } )' > uniprot_sprot.1000.2.json
616 :     time perl -e 'use SwissProtUtils; SwissProtUtils::XML_to_JSON( "", { processes => 8 } )' < uniprot_sprot.1000.xml > uniprot_sprot.1000.3.json
617 :    
618 :     time perl -e 'use SwissProtUtils; SwissProtUtils::XML_to_JSON( "uniprot_sprot.xml", { loadfile => 1, processes => 8 } )' > uniprot_sprot.loadfile
619 :    
620 :     time perl -e 'use SwissProtUtils; SwissProtUtils::XML_to_JSON( "uniprot_sprot.xml", "uniprot_sprot.2.json", { processes => 8 } )'
621 :     8320.864u 111.919s 18:00.14 780.7% 0+0k 322+1145io 274pf+0w
622 :    
623 :     time perl -e 'use SwissProtUtils; while ( $_ = SwissProtUtils::next_JSON_entry() ) { push @ids, SwissProtUtils::id($_) } print scalar @ids, "\n"' < uniprot_sprot.xml
624 :    
625 :     time perl -e 'use SwissProtUtils; SwissProtUtils::XML_to_JSON( "uniprot_sprot.xml", { processes => 8 } )' > uniprot_sprot.json.new &
626 :    
627 :     End_of_Notes
628 :    
629 :     #-------------------------------------------------------------------------------
630 :     # Read the Swiss-Prot XML format distribution file, producing a file with
631 :     # a one-line JSON conversion.
632 :     #
633 :     # XML_to_JSON( $in_file, $out_file, \%options )
634 :     # XML_to_JSON( $in_file, \%options )
635 :     # XML_to_JSON( \%options )
636 :     #
637 :     # $in_file can be a file name, open file handle or string reference, defining
638 :     # the source of the XML. If undefined or an empty string, input is from
639 :     # STDIN.
640 :     #
641 :     # $out_file can be a file name, open file handle or string reference, defining
642 :     # the destination for the JSON. If undefined or an empty string, output
643 :     # is to STDOUT.
644 :     #
645 :     # Options:
646 :     #
647 :     # condensed => $bool # If true, do not invoke 'pretty'
648 :     # loadfile => $bool # Forces 1-line output of:
649 :     # # acc, id, md5, function, org, taxid, json
650 :     # pretty => $bool # If explicitly false, do not invoke 'pretty'
651 :     # processes => $int # Number of parallel processes to spawn
652 :     # subset => [$i,$n] # Process the $i'th segment of $n segments in the
653 :     # # input file (generally, this should not be
654 :     # # invoked by the user).
655 :     #
656 :     # Note: The load file option is generally not recommend if one will also
657 :     # want the JSON format by itself. Conversion to JSON followed by
658 :     # a separate conversion to the load file is almost as fast, and is
659 :     # almost twice as fast as producing the two conversions separately.
660 :     #-------------------------------------------------------------------------------
661 :    
662 :     sub XML_to_JSON
663 :     {
664 :     my $opts = ref( $_[-1] ) eq 'HASH' ? pop @_ : {};
665 :    
666 :     my ( $in_file, $out_file ) = @_;
667 :    
668 :     my $n_proc = $opts->{ processes } ||= 1;
669 :     if ( $n_proc > 1 )
670 :     {
671 :     return XML_to_JSON_par( $in_file, $out_file, $opts );
672 :     }
673 :    
674 :     my ( $in_fh, $in_close ) = input_file_handle( $in_file );
675 :     $in_fh or die "SwissProtUtils::XML_to_JSON could not open data source.";
676 :    
677 :     # For safety, subsetting is limited to files, so we know that noone
678 :     # else is using the same file handle.
679 :    
680 :     my ( $i, $n, $first, $last );
681 :     my $subset = $opts->{ subset };
682 :     if ( ref( $subset ) eq 'ARRAY' && @$subset == 2 && -f $in_file )
683 :     {
684 :     ( $i, $n ) = @$subset;
685 :     if ( $i > 0 && $n > 1 && $i <= $n )
686 :     {
687 :     my $len = -s $in_file;
688 :     my $step = int( ( $len + $n - 1 ) / $n );
689 :    
690 :     $first = ( $i - 1 ) * $step;
691 :     seek( $in_fh, $first, 0 );
692 :    
693 :     $last = $i * $step - 1;
694 :     $opts->{ max_start } = $last;
695 :     }
696 :     else
697 :     {
698 :     print STDERR "Error: XML_to_JSON called with bad subset paramater:\n", Dumper( $subset );
699 :     die "Bad parameter.";
700 :     }
701 :     }
702 :    
703 :     my ( $out_fh, $out_close ) = output_file_handle( $out_file, $opts );
704 :     $out_fh or die "SwissProtUtils::XML_to_JSON could not open data destination.";
705 :    
706 :     # The loadfile option forces condensed output, and adds a prefix with some
707 :     # additional data.
708 :     my $loadfile = $opts->{ loadfile };
709 :    
710 :     my $pretty = $loadfile ? 0
711 :     : $opts->{pretty} ? 1
712 :     : ( exists( $opts->{condensed} ) && ! $opts->{condensed} ) ? 1
713 :     : 0;
714 :    
715 :     # Pretty format includes the newline, but condensed does not
716 :     my $suffix = $pretty ? '' : "\n";
717 :    
718 :     my $json = JSON::XS->new->ascii->pretty( $pretty )
719 :     or next;
720 :    
721 :     my $cnt = 0;
722 :     my $entry;
723 :     while ( defined( $entry = next_XML_entry( $in_fh, $opts ) ) )
724 :     {
725 :     my @items = ();
726 :     push @items, loadfile_items( $entry ) if $loadfile;
727 :    
728 :     print $out_fh join "\t", @items, $json->encode( $entry ) . $suffix;
729 :     $cnt++;
730 :    
731 :     last if $last && tell( $in_fh ) > $last;
732 :     }
733 :    
734 :     close( $in_file ) if $in_close;
735 :     close( $out_file ) if $out_close;
736 :    
737 :     $cnt;
738 :     }
739 :    
740 :    
741 :     #
742 :     # This is meant as an internal routine called by XML_to_JSON() when
743 :     # processes > 1.
744 :     #
745 :     sub XML_to_JSON_par
746 :     {
747 :     my $opts = ref( $_[-1] ) eq 'HASH' ? pop @_ : {};
748 :    
749 :     my ( $in_file, $out_file ) = @_;
750 :    
751 :     my $n_proc = $opts->{ processes } ||= 4;
752 :    
753 :     my $Parallel_Loops;
754 :     if ( eval { require Parallel::Loops; } )
755 :     {
756 :     $Parallel_Loops = 1;
757 :     }
758 :     elsif ( eval { require Proc::ParallelLoop; } )
759 :     {
760 :     $Parallel_Loops = 0;
761 :     }
762 :     else
763 :     {
764 :     print STDERR "Failed in 'require Parallel::Loops' and 'require Proc::ParallelLoop'; reverting to single process.\n";
765 :     $opts->{ processes } = 1;
766 :     return XML_to_JSON( $in_file, $out_file, $opts );
767 :     }
768 :    
769 :     # If $in_file is a file, we are good, otherwise we need to write a file.
770 :    
771 :     if ( ! $in_file || ref( $in_file ) eq 'GLOB' || ref( $in_file ) eq 'SCALAR' )
772 :     {
773 :     my $input = $in_file || \*STDIN;
774 :    
775 :     my $out_fh;
776 :     ( $out_fh, $in_file ) = File::Temp::tempfile( UNLINK => 1 );
777 :     if ( ref( $input ) eq 'GLOB' )
778 :     {
779 :     local $_;
780 :     while ( <$input> ) { print $out_fh $_ } # Open file handle or STDIN
781 :     }
782 :     else
783 :     {
784 :     print $out_fh $$input; # Reference to scalar
785 :     }
786 :     close( $out_fh );
787 :     }
788 :     elsif ( ! -f $in_file )
789 :     {
790 :     print STDERR "Cannot find input file '$in_file'.\n";
791 :     return undef;
792 :     }
793 :    
794 :     # Create calling parameters (including individual output file names)
795 :     # for the workers.
796 :    
797 :     my @work = map { my ( $out_fh, $out_fn ) = File::Temp::tempfile( UNLINK => 1 );
798 :     close( $out_fh );
799 :    
800 :     my %worker_opts = map { $_ => $opts->{ $_ } }
801 :     grep { $_ ne 'processes' }
802 :     keys %$opts;
803 :     $worker_opts{ subset } = [ $_, $n_proc ];
804 :    
805 :     [ $in_file, $out_fn, \%worker_opts ];
806 :     }
807 :     ( 1 .. $n_proc );
808 :    
809 :     my @worker_out = map { $_->[1] } @work;
810 :     my $cnts = 0;
811 :    
812 :     if ( $Parallel_Loops )
813 :     {
814 :     my $pl = Parallel::Loops->new( $n_proc );
815 :    
816 :     my @cnts;
817 :     $pl->share( \@cnts );
818 :     $pl->foreach( \@work, sub { push @cnts, XML_to_JSON( @$_ ) } );
819 :    
820 :     foreach ( @cnts ) { $cnts += $_ };
821 :     }
822 :     else
823 :     {
824 :     Proc::ParallelLoop::pareach( \@work, sub { XML_to_JSON( @{$_[0]} ) } );
825 :    
826 :     $cnts = undef;
827 :     }
828 :    
829 :     # If $out_file is a file name, we can use cat to join the worker outputs.
830 :     # Otherwise we need to or a string reference, we are good, otherwise we
831 :     # need to write a file.
832 :    
833 :     if ( ! $out_file )
834 :     {
835 :     # cat the files to stdout
836 :    
837 :     system( 'cat', @worker_out );
838 :     }
839 :     elsif ( ! ref( $out_file ) )
840 :     {
841 :     # This is running through the shell, so file names are vulnerable.
842 :    
843 :     ( $out_file, @worker_out ) = map { quotemeta( $_ ) }
844 :     ( $out_file, @worker_out );
845 :    
846 :     system( join( ' ', 'cat', @worker_out, '>', $out_file ) );
847 :     }
848 :     elsif ( ref( $out_file ) eq 'GLOB' )
849 :     {
850 :     my $out_fh = $out_file;
851 :    
852 :     foreach ( @worker_out )
853 :     {
854 :     open( FH, '<', $_ );
855 :     print $out_fh <FH>;
856 :     close( FH );
857 :     }
858 :     close( $out_fh ) if $out_file;
859 :     }
860 :     elsif ( ref( $out_file ) eq 'scalar' )
861 :     {
862 :     foreach ( @worker_out )
863 :     {
864 :     open( FH, '<', $_ );
865 :     $$out_file .= join( '', <FH> );
866 :     close( FH );
867 :     }
868 :     }
869 :     else
870 :     {
871 :     my $out_type = ref( $out_file );
872 :     print STDERR "Bad output file reference type '$out_type'\n";
873 :     return undef;
874 :     }
875 :    
876 :     $cnts;
877 :     }
878 :    
879 :    
880 :     #-------------------------------------------------------------------------------
881 :     # Get next XML entry as a perl structure, or undef on EOF or error. Partial
882 :     # initial or final entries are discarded. Also, fix perl structure
883 :     # format inconsistencies, and add the sequence md5.
884 :     #
885 :     # $entry = next_XML_entry( \*FH, \%opts )
886 :     # $entry = next_XML_entry( \*FH )
887 :     # $entry = next_XML_entry( \%opts ) # STDIN
888 :     # $entry = next_XML_entry() # STDIN
889 :     #
890 :     # Options:
891 :     #
892 :     # max_read => $offset # Maximum file offset for starting a new entry;
893 :     # # this should not be set by the user
894 :     #
895 :     #-------------------------------------------------------------------------------
896 :     sub next_XML_entry
897 :     {
898 :     my $opts = ref $_[-1] eq 'HASH' ? pop @_ : {};
899 :     my $fh = $_[0] || \*STDIN;
900 :    
901 :     my $max = $opts->{ max_start };
902 :     my $state = 0;
903 :     my @lines;
904 :     while ( <$fh> )
905 :     {
906 :     if ( m#^<entry\b# )
907 :     {
908 :     my $pos = tell( $fh ) - length( $_ );
909 :     last if $max && $pos > $max;
910 :     @lines = ();
911 :     $state = 1;
912 :     }
913 :    
914 :     push @lines, $_ if $state == 1;
915 :    
916 :     if ( $state == 1 && m#^</entry># )
917 :     {
918 :     $state = 2;
919 :     last;
920 :     }
921 :     }
922 :    
923 :     $state == 2
924 :     or return undef;
925 :    
926 :     my $entry = XMLin( join( '', @lines ), ForceArray => 1, KeyAttr => [] )
927 :     or return undef;
928 :    
929 :     fix_XML_content( $entry );
930 :    
931 :     # Add the sequence md5 as an attribute of the sequence element
932 :    
933 :     my $uc_seq = uc( ( ( $entry->{ sequence } || [] )->[0] || {} )->{_} || '' )
934 :     or return undef;
935 :    
936 :     $entry->{ sequence }->[0]->{ md5 } = Digest::MD5::md5_hex( $uc_seq );
937 :    
938 :     $entry;
939 :     }
940 :    
941 :    
942 :     #
943 :     # This routine recursively fixes the content embraced by two tags.
944 :     #
945 :     sub fix_XML_content
946 :     {
947 :     #
948 :     # This is text between open and close tags with no attributes.
949 :     # Move it into a hash, keyed by '_'. Most cases are caught before
950 :     # the recursive call, but for the outermost tag pair:
951 :     #
952 :     if ( ! ref $_[0] )
953 :     {
954 :     $_[0] = { _ => $_[0] };
955 :     return;
956 :     }
957 :    
958 :     my $hash = shift;
959 :     foreach my $key ( keys %$hash )
960 :     {
961 :     # Hash key can either be a scalar value of a tag attribute,
962 :     # or a list of internal tags with this name.
963 :    
964 :     my $val = $hash->{ $key };
965 :     if ( ! ref $val )
966 :     {
967 :     if ( $key eq 'content' )
968 :     {
969 :     $hash->{ _ } = $hash->{ content };
970 :     delete $hash->{ content };
971 :     }
972 :     next;
973 :     }
974 :    
975 :     ref( $val ) eq 'ARRAY'
976 :     or die "Thought I had an ARRAY ref, but did not.";
977 :    
978 :     foreach ( @$val )
979 :     {
980 :     #
981 :     # This is text between the tags when there are no attributes.
982 :     # Move it into a hash, keyed by '_':
983 :     #
984 :     if ( ! ref( $_ ) )
985 :     {
986 :     $_ = { _ => $_ };
987 :     }
988 :    
989 :     # This is content between tags of type $tag; if there is a
990 :     # hash
991 :     elsif ( ref( $_ ) eq 'HASH' )
992 :     {
993 :     fix_XML_content( $_ );
994 :     }
995 :    
996 :     else
997 :     {
998 :     die "Unexpected datatype in list of tag instances.";
999 :     }
1000 :     }
1001 :     }
1002 :     }
1003 :    
1004 :    
1005 :     #-------------------------------------------------------------------------------
1006 :     # Take the XML version of Swiss-Prot (or Uni-Prot) and convert to a
1007 :     # loadfile with:
1008 :     #
1009 :     # acc, id, md5, function, org, taxid, json
1010 :     #
1011 :     # $record_cnt = XML_to_loadfile( $XML_infile, $loadfile )
1012 :     #
1013 :     # Files can be supplied as filename, filehandle, or string reference.
1014 :     # Files default to STDIN and STDOUT.
1015 :     #
1016 :     # Options: Currently there are no options, but an options hash will be
1017 :     # passed through, if provided.
1018 :     #
1019 :     #-------------------------------------------------------------------------------
1020 :     sub XML_to_loadfile
1021 :     {
1022 :     my $opts = ref( $_[-1] ) eq 'HASH' ? pop @_ : {};
1023 :     $opts->{ loadfile } = 1;
1024 :     XML_to_JSON( @_, $opts );
1025 :     }
1026 :    
1027 :    
1028 :     #-------------------------------------------------------------------------------
1029 :     # Read a file of JSON entries one at a time. Returns undef at the end of the
1030 :     # file. The routine assumes that the JSON text is all on one line. The
1031 :     # JSON::XS object used for decoding is cached in the options hash, but should
1032 :     # not be set by the user unless they must use an unusual character coding.
1033 :     #
1034 :     # $entry = next_JSON_entry( \*FH, \%opts )
1035 :     # $entry = next_JSON_entry( \*FH )
1036 :     # $entry = next_JSON_entry( \%opts ) # STDIN
1037 :     # $entry = next_JSON_entry() # STDIN
1038 :     #
1039 :     # Options:
1040 :     #
1041 :     # json => $jsonObject
1042 :     #
1043 :     #-------------------------------------------------------------------------------
1044 :    
1045 :     sub next_JSON_entry
1046 :     {
1047 :     my $opts = ref $_[-1] eq 'HASH' ? pop @_ : {};
1048 :     my $fh = $_[0] || \*STDIN;
1049 :     my $json = $opts->{ json } ||= JSON::XS->new->utf8(0) or return undef;
1050 :    
1051 :     local $_ = <$fh>;
1052 :    
1053 :     $_ && /^\s*\{/ ? $json->decode( $_ ) : undef;
1054 :     }
1055 :    
1056 :    
1057 :     #-------------------------------------------------------------------------------
1058 :     # Read the output of XML to JSON, and create a loadfile.
1059 :     # This assumes that the JSON text is all on one line.
1060 :     #
1061 :     # JSON_to_loadfile( $infile, $outfile, \%opts )
1062 :     # JSON_to_loadfile( $infile, $outfile )
1063 :     # JSON_to_loadfile( $infile, \%opts ) # STDOUT
1064 :     # JSON_to_loadfile( $infile ) # STDOUT
1065 :     # JSON_to_loadfile( \%opts ) # STDIN, STDOUT
1066 :     # JSON_to_loadfile() # STDIN, STDOUT
1067 :     #
1068 :     # Options:
1069 :     #
1070 :     # infile => $in_file
1071 :     # infile => \*in_fh
1072 :     # infile => \$in_str
1073 :     # outfile => $out_file
1074 :     # outfile => \*out_fh
1075 :     # outfile => \$out_str
1076 :     #
1077 :     # Positional parameters take precedence over options.
1078 :     #-------------------------------------------------------------------------------
1079 :    
1080 :     sub JSON_to_loadfile
1081 :     {
1082 :     my $opts = ref $_[-1] eq 'HASH' ? pop @_ : {};
1083 :    
1084 :     my $in_file = $_[0] || $opts->{ infile };
1085 :     my ( $in_fh, $in_close ) = input_file_handle( $in_file );
1086 :    
1087 :     my $out_file = $_[1] || $opts->{ outfile };
1088 :     my ( $out_fh, $out_close ) = output_file_handle( $out_file );
1089 :    
1090 :     # For decoding the strings read
1091 :     my $json = $opts->{ json } ||= JSON::XS->new->utf8(0) or return undef;
1092 :    
1093 :     my $cnt = 0;
1094 :     local $_;
1095 :     while ( <$in_fh> )
1096 :     {
1097 :     my $entry = $_ && /^\s*\{/ ? $json->decode( $_ ) : undef;
1098 :     $entry or next;
1099 :    
1100 :     print $out_fh join( "\t", loadfile_items( $entry ), $_ );
1101 :     $cnt++;
1102 :     }
1103 :    
1104 :     close( $in_file ) if $in_close;
1105 :     close( $out_file ) if $out_close;
1106 :    
1107 :     $cnt;
1108 :     }
1109 :    
1110 :    
1111 :     #-------------------------------------------------------------------------------
1112 :     # The internal function that sets the load file items, deriving them from the
1113 :     # Swiss-Prot entry.
1114 :     #
1115 :     # ( $acc, $id, $md5, $def, $org, $taxid ) = loadfile_items( $sp_entry )
1116 :     #
1117 :     #-------------------------------------------------------------------------------
1118 :     sub loadfile_items
1119 :     {
1120 :     my ( $entry ) = @_;
1121 :    
1122 :     my ( $taxid ) = map { $_->[0] eq 'NCBI Taxonomy' ? $_->[1] : () } org_xref( $entry );
1123 :    
1124 :     my @items = ( scalar accession( $entry ), # Primary accession number
1125 :     id( $entry ), # Entry ID
1126 :     md5( $entry ) || '', # Protein sequence md5
1127 :     scalar assignment( $entry ), # Entry full definition
1128 :     scalar organism( $entry ), # Organism name
1129 :     $taxid || '' # NCBI taxonomy ID
1130 :     );
1131 :    
1132 :     wantarray ? @items : \@items;
1133 :     }
1134 :    
1135 :     #
1136 :     # Produce a report of the subelements, attributes and values in the XML
1137 :     #
1138 :     # \%child_counts_by_element = analyze_sp( $file )
1139 :     #
1140 :     # report_sp_analysis( $file )
1141 :     #
1142 :     # Printed a report of attributes and subelements, sorted by: "entry." ... .$parent.$element
1143 :     # Comment elements are special in that they are qualified with their type.
1144 :     #
1145 :     # perl -e 'use SwissProtUtils; SwissProtUtils::report_sp_struct()' < uniprot_sprot.json > uniprot_sprot.xml.report
1146 :     #
1147 :    
1148 :     sub report_sp_struct
1149 :     {
1150 :     my $cnts = analyze_sp( @_ );
1151 :    
1152 :     foreach ( sort { lc $a cmp lc $b } keys %$cnts )
1153 :     {
1154 :     print "$_\n";
1155 :    
1156 :     my $attribD = $cnts->{ $_ }->[0];
1157 :     if ( keys %$attribD )
1158 :     {
1159 :     print " attributes:\n";
1160 :     my @attrib = map { [ $attribD->{ $_ }, $_ ] }
1161 :     sort { lc $a cmp lc $b }
1162 :     keys %$attribD;
1163 :     foreach ( @attrib ) { printf "%12d %s\n", @$_ }
1164 :     }
1165 :    
1166 :     my $elementD = $cnts->{ $_ }->[1];
1167 :     if ( keys %$elementD )
1168 :     {
1169 :     print " subelements:\n";
1170 :     my @element = map { [ $elementD->{ $_ }, $_ ] }
1171 :     sort { lc $a cmp lc $b }
1172 :     keys %$elementD;
1173 :     foreach ( @element ) { printf "%12d %s\n", @$_ }
1174 :     }
1175 :    
1176 :     print "\n";
1177 :     }
1178 :     }
1179 :    
1180 :    
1181 :     sub analyze_sp
1182 :     {
1183 :     my ( $fh, $close ) = input_file_handle( $_[0] );
1184 :     my $cnts = {}; # $cnts{ $element } = [ \%attrib, \%subel ]
1185 :     local $_;
1186 :     while ( $_ = next_JSON_entry( $fh ) )
1187 :     {
1188 :     analyze_element( $cnts, $_, 'entry', '' )
1189 :     }
1190 :    
1191 :     $cnts;
1192 :     }
1193 :    
1194 :    
1195 :     sub analyze_element
1196 :     {
1197 :     my ( $cnts, $element, $name, $parent ) = @_;
1198 :    
1199 :     my @attrib = grep { ! ref( $element->{ $_ } ) } keys %$element;
1200 :     my @child = grep { ref( $element->{ $_ } ) eq 'ARRAY' } keys %$element;
1201 :    
1202 :     # Comments will be qualified by their type.
1203 :    
1204 :     $name .= "/$element->{type}" if $name eq 'comment';
1205 :    
1206 :     my $path = ! $parent ? $name : "$parent.$name";
1207 :     my $pathD = $cnts->{ $path } ||= [ {}, {} ];
1208 :    
1209 :     foreach ( @attrib )
1210 :     {
1211 :     $pathD->[0]->{ $_ }++;
1212 :     }
1213 :    
1214 :     foreach my $subname ( @child )
1215 :     {
1216 :     $pathD->[1]->{ $subname }++;
1217 :     foreach ( @{ $element->{ $subname } } )
1218 :     {
1219 :     analyze_element( $cnts, $_, $subname, $path );
1220 :     }
1221 :     }
1222 :     }
1223 :    
1224 :    
1225 :     #-------------------------------------------------------------------------------
1226 :     # Access function summary (work-in-progress):
1227 :     #
1228 :     # scalar array
1229 :     # 1 L accession
1230 :     # x created
1231 :     # x dataset
1232 :     # R L features
1233 :     # function
1234 :     # 1 L gene
1235 :     # hosts
1236 :     # x id
1237 :     # L keywords
1238 :     # x length
1239 :     # x modified
1240 :     # 1 L organism
1241 :     # x mass
1242 :     # x md5
1243 :     # R L references
1244 :     # x sequence
1245 :     # x seqversion
1246 :     # x seqmoddate
1247 :     # taxonomy
1248 :     # taxonomyxref
1249 :     # x version
1250 :     # R L xref
1251 :     #
1252 :     # Access functions for Swiss-Prot features:
1253 :     #
1254 :     # description
1255 :     # id
1256 :     # location
1257 :     # type
1258 :     #
1259 :     # Access functions for Swiss-Prot references:
1260 :     #
1261 :     # authors
1262 :     # doi
1263 :     # index
1264 :     # journal
1265 :     # pages
1266 :     # pubmedid
1267 :     # scope
1268 :     # source
1269 :     # title
1270 :     # type
1271 :     # volume
1272 :     # xref
1273 :     # year
1274 :     #
1275 :     #
1276 :     # All access functions return undef (or empty list) in case of failure
1277 :     #
1278 :    
1279 :     #-------------------------------------------------------------------------------
1280 :     # Accessing data from a Swiss-Prot entry
1281 :     #-------------------------------------------------------------------------------
1282 :     #
1283 :     # entry
1284 :     # attributes:
1285 :     # 550740 created
1286 :     # 550740 dataset
1287 :     # 550740 modified
1288 :     # 550740 version
1289 :     # subelements:
1290 :     # 550740 accession
1291 :     # 542755 comment
1292 :     # 550479 dbReference
1293 :     # 543045 evidence
1294 :     # 550740 feature
1295 :     # 528250 gene
1296 :     # 20479 geneLocation
1297 :     # 547826 keyword
1298 :     # 550740 name
1299 :     # 550740 organism
1300 :     # 16545 organismHost
1301 :     # 550740 protein
1302 :     # 550740 proteinExistence
1303 :     # 550740 reference
1304 :     # 550740 sequence
1305 :     #
1306 :    
1307 :     #-------------------------------------------------------------------------------
1308 :     # Top level entry data:
1309 :     #
1310 :     # $creation_date = created( $entry ) # YYYY-MM-DD
1311 :     # $modif_date = modified( $entry ) # YYYY-MM-DD
1312 :     # $version = version( $entry )
1313 :     # $keyword = dataset( $entry ) # Swiss-Prot | TREMBL
1314 :     #
1315 :     # These are attributes on the entry element, and are put on the ID line of the
1316 :     # flat file.
1317 :     #-------------------------------------------------------------------------------
1318 :    
1319 :     sub created { ( $_[0] || {} )->{ created } }
1320 :     sub modified { ( $_[0] || {} )->{ modified } }
1321 :     sub version { ( $_[0] || {} )->{ version } }
1322 :     sub dataset { ( $_[0] || {} )->{ dataset } }
1323 :    
1324 :    
1325 :     #-------------------------------------------------------------------------------
1326 :     # Some entry element extractors:
1327 :     #-------------------------------------------------------------------------------
1328 :    
1329 :     sub acc_elements { ( $_[0] || {} )->{ accession } || [] }
1330 :     sub name_element { ( ( $_[0] || {} )->{ name } || [] )->[0] || {} }
1331 :     sub protein_element { ( ( $_[0] || {} )->{ protein } || [] )->[0] || {} }
1332 :     sub gene_elements { ( $_[0] || {} )->{ gene } || [] }
1333 :     sub organism_element { ( ( $_[0] || {} )->{ organism } || [] )->[0] || {} }
1334 :     sub org_host_elements { ( $_[0] || {} )->{ organismHost } || [] }
1335 :     sub gene_loc_elements { ( $_[0] || {} )->{ geneLocation } || [] }
1336 :     sub reference_elements { ( $_[0] || {} )->{ reference } || [] }
1337 :     sub comment_elements { ( $_[0] || {} )->{ comment } || [] }
1338 :     sub xref_elements { ( $_[0] || {} )->{ dbReference } || [] }
1339 :     sub prot_exist_element { ( ( $_[0] || {} )->{ proteinExistence } || [] )->[0] || {} }
1340 :     sub keyword_elements { ( $_[0] || {} )->{ keyword } || [] }
1341 :     sub feature_elements { ( $_[0] || {} )->{ feature } || [] }
1342 :     sub evidence_elements { ( $_[0] || {} )->{ evidence } || [] }
1343 :     sub sequence_element { ( ( $_[0] || {} )->{ sequence } || [] )->[0] || {} }
1344 :    
1345 :    
1346 :     #-------------------------------------------------------------------------------
1347 :     # Accession data
1348 :     #
1349 :     # @acc = accession( $entry )
1350 :     # $acc = accession( $entry ) # Just the first one
1351 :     #
1352 :     #-------------------------------------------------------------------------------
1353 :     #
1354 :     # entry.accession
1355 :     # attributes:
1356 :     # 780033 _
1357 :     #
1358 :    
1359 :     sub accession
1360 :     {
1361 :     my @acc = map { $_->{_} } @{ acc_elements( @_ ) };
1362 :     wantarray ? @acc : $acc[0];
1363 :     }
1364 :    
1365 :    
1366 :     #-------------------------------------------------------------------------------
1367 :     # Protein name data.
1368 :     #
1369 :     # $id = id( $entry )
1370 :     # $id = name( $entry )
1371 :     #
1372 :     # This is on the ID line of the flat file, and the name element in the XML.
1373 :     # It is never repeated, though the XML spec says that it can be.
1374 :     #-------------------------------------------------------------------------------
1375 :     #
1376 :     # entry.name
1377 :     # attributes:
1378 :     # 550740 _
1379 :     #
1380 :    
1381 :     sub id { name_element( @_ )->{_} }
1382 :     sub name { name_element( @_ )->{_} } # Same as id()
1383 :    
1384 :    
1385 :     #-------------------------------------------------------------------------------
1386 :     # Protein name/function data
1387 :     #-------------------------------------------------------------------------------
1388 :     #
1389 :     # $full_recommend = assignment( $entry );
1390 :     #
1391 :     # ( [ $category, $type, $name, $evidence, $status, $qualif ], ... ) = assignments( $entry )
1392 :     #
1393 :     # Category is one of: recommened | alternative | submitted
1394 :     #
1395 :     # Type is one of: full | short | EC
1396 :     #
1397 :     # Qualif is one of: '' | domain | contains
1398 :     #
1399 :     # where:
1400 :     #
1401 :     # domain describes a protein domain
1402 :     # contains describes a product of protein processing
1403 :     #
1404 :     #-------------------------------------------------------------------------------
1405 :     #
1406 :     # entry.protein
1407 :     # subelements:
1408 :     # 617 allergenName
1409 :     # 273614 alternativeName
1410 :     # 1527 cdAntigenName
1411 :     # 7863 component
1412 :     # 6044 domain
1413 :     # 24 innName
1414 :     # 550740 recommendedName
1415 :     #
1416 :     # entry.protein.allergenName
1417 :     # attributes:
1418 :     # 617 _
1419 :     # 38 evidence
1420 :     #
1421 :     # entry.protein.alternativeName
1422 :     # subelements:
1423 :     # 6362 ecNumber
1424 :     # 457944 fullName
1425 :     # 97014 shortName
1426 :     #
1427 :     # entry.protein.alternativeName.ecNumber
1428 :     # attributes:
1429 :     # 6489 _
1430 :     # 4433 evidence
1431 :     #
1432 :     # entry.protein.alternativeName.fullName
1433 :     # attributes:
1434 :     # 457944 _
1435 :     # 258362 evidence
1436 :     #
1437 :     # entry.protein.alternativeName.shortName
1438 :     # attributes:
1439 :     # 115481 _
1440 :     # 69791 evidence
1441 :     #
1442 :     # entry.protein.cdAntigenName
1443 :     # attributes:
1444 :     # 1527 _
1445 :     # 5 evidence
1446 :     #
1447 :     # entry.protein.component
1448 :     # subelements:
1449 :     # 1 allergenName
1450 :     # 5624 alternativeName
1451 :     # 21226 recommendedName
1452 :     #
1453 :     # entry.protein.component.allergenName
1454 :     # attributes:
1455 :     # 1 _
1456 :     #
1457 :     # entry.protein.component.alternativeName
1458 :     # subelements:
1459 :     # 100 ecNumber
1460 :     # 7957 fullName
1461 :     # 1373 shortName
1462 :     #
1463 :     # entry.protein.component.alternativeName.ecNumber
1464 :     # attributes:
1465 :     # 100 _
1466 :     #
1467 :     # entry.protein.component.alternativeName.fullName
1468 :     # attributes:
1469 :     # 7957 _
1470 :     # 124 evidence
1471 :     #
1472 :     # entry.protein.component.alternativeName.shortName
1473 :     # attributes:
1474 :     # 1398 _
1475 :     # 36 evidence
1476 :     #
1477 :     # entry.protein.component.recommendedName
1478 :     # subelements:
1479 :     # 2134 ecNumber
1480 :     # 21226 fullName
1481 :     # 5990 shortName
1482 :     #
1483 :     # entry.protein.component.recommendedName.ecNumber
1484 :     # attributes:
1485 :     # 3163 _
1486 :     # 255 evidence
1487 :     #
1488 :     # entry.protein.component.recommendedName.fullName
1489 :     # attributes:
1490 :     # 21226 _
1491 :     # 3485 evidence
1492 :     #
1493 :     # entry.protein.component.recommendedName.shortName
1494 :     # attributes:
1495 :     # 6455 _
1496 :     # 81 evidence
1497 :     #
1498 :     # entry.protein.domain
1499 :     # subelements:
1500 :     # 5667 alternativeName
1501 :     # 13208 recommendedName
1502 :     #
1503 :     # entry.protein.domain.alternativeName
1504 :     # subelements:
1505 :     # 21 ecNumber
1506 :     # 9145 fullName
1507 :     # 1325 shortName
1508 :     #
1509 :     # entry.protein.domain.alternativeName.ecNumber
1510 :     # attributes:
1511 :     # 21 _
1512 :     # 9 evidence
1513 :     #
1514 :     # entry.protein.domain.alternativeName.fullName
1515 :     # attributes:
1516 :     # 9145 _
1517 :     # 6476 evidence
1518 :     #
1519 :     # entry.protein.domain.alternativeName.shortName
1520 :     # attributes:
1521 :     # 1473 _
1522 :     # 878 evidence
1523 :     #
1524 :     # entry.protein.domain.recommendedName
1525 :     # subelements:
1526 :     # 12489 ecNumber
1527 :     # 13208 fullName
1528 :     # 2191 shortName
1529 :     #
1530 :     # entry.protein.domain.recommendedName.ecNumber
1531 :     # attributes:
1532 :     # 12859 _
1533 :     # 9220 evidence
1534 :     #
1535 :     # entry.protein.domain.recommendedName.fullName
1536 :     # attributes:
1537 :     # 13208 _
1538 :     # 9050 evidence
1539 :     #
1540 :     # entry.protein.domain.recommendedName.shortName
1541 :     # attributes:
1542 :     # 2632 _
1543 :     # 1732 evidence
1544 :     #
1545 :     # entry.protein.innName
1546 :     # attributes:
1547 :     # 26 _
1548 :     #
1549 :     # entry.protein.recommendedName
1550 :     # subelements:
1551 :     # 250449 ecNumber
1552 :     # 550740 fullName
1553 :     # 117517 shortName
1554 :     #
1555 :     # entry.protein.recommendedName.ecNumber
1556 :     # attributes:
1557 :     # 254185 _
1558 :     # 184330 evidence
1559 :     #
1560 :     # entry.protein.recommendedName.fullName
1561 :     # attributes:
1562 :     # 550740 _
1563 :     # 318094 evidence
1564 :     #
1565 :     # entry.protein.recommendedName.shortName
1566 :     # attributes:
1567 :     # 145950 _
1568 :     # 89377 evidence
1569 :     #
1570 :    
1571 :     sub assignment
1572 :     {
1573 :     my $recName = protein_element( @_ )->{ recommendedName }->[0];
1574 :    
1575 :     my $EC = join '', map { "(EC $_->{_})" }
1576 :     grep { ! /-/ }
1577 :     @{ $recName->{ ecNumber } || [] };
1578 :    
1579 :     $recName->{ fullName }->[0]->{_} . ( $EC ? " $EC" : '' );
1580 :     }
1581 :    
1582 :    
1583 :     sub assignments
1584 :     {
1585 :     my $element = protein_element( @_ );
1586 :     my @names = prot_name_group( $element );
1587 :     if ( $element->{ domain } )
1588 :     {
1589 :     push @names, map { push @$_, 'domain'; $_ }
1590 :     map { prot_name_group( $_ ) }
1591 :     @{ $element->{ domain } };
1592 :     }
1593 :     if ( $element->{ component } )
1594 :     {
1595 :     push @names, map { push @$_, 'contains'; $_ }
1596 :     map { prot_name_group( $_ ) }
1597 :     @{ $element->{ component } };
1598 :     }
1599 :    
1600 :     wantarray ? @names : \@names;
1601 :     }
1602 :    
1603 :    
1604 :     sub prot_name_group
1605 :     {
1606 :     my $element = shift;
1607 :     my @names;
1608 :    
1609 :     foreach ( [ qw( recommendedName recommened ) ],
1610 :     [ qw( alternativeName alternative ) ],
1611 :     [ qw( submittedName submitted ) ]
1612 :     )
1613 :     {
1614 :     my ( $key, $label ) = @$_;
1615 :     foreach my $element2 ( @{ $element->{ $key } || [] } )
1616 :     {
1617 :     foreach ( [ qw( fullName full ) ],
1618 :     [ qw( shortName short ) ],
1619 :     [ qw( ecNumber EC ) ],
1620 :     )
1621 :     {
1622 :     my ( $key2, $label2 ) = @$_;
1623 :     foreach ( @{ $element2->{ $key2 } || [] } )
1624 :     {
1625 :     push @names, [ $label, $label2, evidenced_string($_) ]
1626 :     }
1627 :     }
1628 :     }
1629 :     }
1630 :    
1631 :     foreach ( [ qw( allergenName allergen ) ],
1632 :     [ qw( biotechName biotech ) ],
1633 :     [ qw( cdAntigenName cd_antigen ) ],
1634 :     [ qw( innName inn ) ]
1635 :     )
1636 :     {
1637 :     my ( $key, $label ) = @$_;
1638 :     foreach ( @{ $element->{ $key } || [] } )
1639 :     {
1640 :     push @names, [ $label, '', evidenced_string($_) ]
1641 :     }
1642 :     }
1643 :    
1644 :     wantarray ? @names : \@names;
1645 :     }
1646 :    
1647 :    
1648 :     #-------------------------------------------------------------------------------
1649 :     # Gene data
1650 :     #-------------------------------------------------------------------------------
1651 :     #
1652 :     # ( [ $gene, $type ], ... ) = gene( $entry );
1653 :     # $gene = gene( $entry );
1654 :     #
1655 :     #
1656 :     # Type is one of: primary | synonym | 'ordered locus' | ORF
1657 :     #
1658 :     #-------------------------------------------------------------------------------
1659 :     #
1660 :     # entry.gene
1661 :     # subelements:
1662 :     # 530815 name
1663 :     #
1664 :     # entry.gene.name
1665 :     # attributes:
1666 :     # 1073130 _
1667 :     # 316352 evidence
1668 :     # 1073130 type
1669 :     #
1670 :    
1671 :     sub gene
1672 :     {
1673 :     my %priority = ( primary => 4,
1674 :     synonym => 3,
1675 :     'ordered locus' => 2,
1676 :     ORF => 1
1677 :     );
1678 :    
1679 :     my @genes = sort { ( $priority{ $b->[1] } || 0 ) <=> ( $priority{ $a->[1] } || 0 )
1680 :     || lc $a->[0] cmp lc $b->[0]
1681 :     }
1682 :     map { [ $_->{_}, $_->{ type }, $_->{ evidence } ] }
1683 :     map { @{ $_->{ name } || [] } }
1684 :     @{ gene_elements( @_ ) };
1685 :    
1686 :     wantarray ? @genes : ( $genes[0] || [] )->[0];
1687 :     }
1688 :    
1689 :    
1690 :     #-------------------------------------------------------------------------------
1691 :     #
1692 :     # $tag = locus_tag( $entry );
1693 :     # @tags = locus_tag( $entry );
1694 :     #
1695 :     #-------------------------------------------------------------------------------
1696 :    
1697 :     sub locus_tag
1698 :     {
1699 :     my @tags = map { $_->[0] }
1700 :     grep { $_->[1] eq 'ordered locus' }
1701 :     gene( @_ );
1702 :    
1703 :     wantarray ? @tags : $tags[0];
1704 :     }
1705 :    
1706 :    
1707 :     #-------------------------------------------------------------------------------
1708 :     # Organism data
1709 :     #-------------------------------------------------------------------------------
1710 :     #
1711 :     # ( [ $name, $type ], ... ) = organism( $entry );
1712 :     # $name = organism( $entry );
1713 :     #
1714 :     # Type is one of: scientific | common | synonym | full | abbreviation
1715 :     #
1716 :    
1717 :     sub organism
1718 :     {
1719 :     org_name_2( organism_element( @_ ) );
1720 :     }
1721 :    
1722 :    
1723 :     #
1724 :     # Internal function for extracting and organizing organism name data
1725 :     #
1726 :     # @name_type_pairs = org_name_2( $org_element );
1727 :     # $name = org_name_2( $org_element );
1728 :     #
1729 :     sub org_name_2
1730 :     {
1731 :     my %priority = ( scientific => 5,
1732 :     common => 4,
1733 :     synonym => 3,
1734 :     full => 2, # Have not yet found any examples
1735 :     abbreviation => 1 # Have not yet found any examples
1736 :     );
1737 :    
1738 :     my @names = sort { ( $priority{ $b->[1] } || 0 ) <=> ( $priority{ $a->[1] } || 0 )
1739 :     || lc $a->[0] cmp lc $b->[0]
1740 :     }
1741 :     map { [ $_->{_}, $_->{ type } ] }
1742 :     @{ ( $_[0] || {} )->{ name } || [] };
1743 :    
1744 :     wantarray ? @names : ( $names[0] || [] )->[0];
1745 :     }
1746 :    
1747 :    
1748 :     #-------------------------------------------------------------------------------
1749 :     # Taxonomy data
1750 :     #-------------------------------------------------------------------------------
1751 :     #
1752 :     # @taxa = taxonomy( $entry ); # List of taxa
1753 :     # \@taxa = taxonomy( $entry ); # Reference to list of taxa
1754 :     #
1755 :    
1756 :     sub taxonomy
1757 :     {
1758 :     taxonomy_2( organism_element( @_ ) );
1759 :     }
1760 :    
1761 :    
1762 :     #
1763 :     # Internal function for extracting the lineage records and converting to list
1764 :     #
1765 :     # @taxa = taxonomy_2( $org_element );
1766 :     # \@taxa = taxonomy_2( $org_element );
1767 :     #
1768 :    
1769 :     sub taxonomy_2
1770 :     {
1771 :     my @lineage = map { $_->{_} }
1772 :     @{ ( ( ( $_[0] || {} )->{ lineage } || [] )->[0] || {} )->{ taxon } || [] };
1773 :    
1774 :     wantarray ? @lineage : @lineage ? \@lineage : undef;
1775 :     }
1776 :    
1777 :    
1778 :     sub org_xref
1779 :     {
1780 :     xref( organism_element( @_ ) );
1781 :     }
1782 :    
1783 :    
1784 :     #-------------------------------------------------------------------------------
1785 :     # Host organism data
1786 :     #-------------------------------------------------------------------------------
1787 :     #
1788 :     # @hosts = host( $entry ) # List of hosts
1789 :     # $host = host( $entry ) # First host
1790 :     #
1791 :     # Each host is [ $scientific_name, $common_name, $NCBI_taxid ]
1792 :     #
1793 :    
1794 :     sub host
1795 :     {
1796 :     my @hosts;
1797 :     foreach my $org ( @{ org_host_elements( @_ ) } )
1798 :     {
1799 :     my @names = map { [ $_->{_}, $_->{ type } ] } @{ $org->{ name } || [] };
1800 :    
1801 :     my ( $sci_name ) = map { $_->[0] }
1802 :     grep { $_->[1] eq 'scientific' }
1803 :     @names;
1804 :    
1805 :     my ( $com_name ) = map { $_->[0] }
1806 :     grep { $_->[1] eq 'common' }
1807 :     @names;
1808 :    
1809 :     my ( $ncbi_taxid ) = map { "NCBI_taxid: $_->[1]" }
1810 :     grep { $_->[0] eq 'NCBI Taxonomy' }
1811 :     xref2( $org );
1812 :    
1813 :     push @hosts, [ $sci_name, $com_name, $ncbi_taxid ] if $sci_name or $com_name;
1814 :     }
1815 :    
1816 :     wantarray ? @hosts : @hosts[0];
1817 :     }
1818 :    
1819 :    
1820 :     #-------------------------------------------------------------------------------
1821 :     # Gene location data
1822 :     #
1823 :     # @gene_loc = gene_loc( $entry )
1824 :     # \@gene_loc = gene_loc( $entry )
1825 :     #
1826 :     # $gene_loc is a string with either compartment, or a "compartment: element_name"
1827 :     #
1828 :     #-------------------------------------------------------------------------------
1829 :     #
1830 :     # entry.geneLocation
1831 :     # attributes:
1832 :     # 114 evidence
1833 :     # 21022 type
1834 :     # subelements:
1835 :     # 4289 name
1836 :     #
1837 :     # entry.geneLocation.name
1838 :     # attributes:
1839 :     # 4644 _
1840 :     #
1841 :    
1842 :     sub gene_loc
1843 :     {
1844 :     my @locs;
1845 :     foreach ( @{ gene_loc_elements( @_ ) } )
1846 :     {
1847 :     my $type = $_->{ type };
1848 :     my @names = map { $_->{_} } @{ $_->{ name } || [] };
1849 :     push @locs, @names ? map { "$type $_" } @names : $type;
1850 :     }
1851 :    
1852 :     wantarray ? @locs : @locs ? join( '; ', @locs ): '';
1853 :     }
1854 :    
1855 :    
1856 :    
1857 :     #-------------------------------------------------------------------------------
1858 :     # Reference data
1859 :     #-------------------------------------------------------------------------------
1860 :     #
1861 :     # entry.reference
1862 :     # attributes:
1863 :     # 20922 evidence
1864 :     # 1138598 key
1865 :     # subelements:
1866 :     # 1138598 citation
1867 :     # 1138598 scope
1868 :     # 746472 source
1869 :     #
1870 :     # entry.reference.citation
1871 :     # attributes:
1872 :     # 1369 city
1873 :     # 428 country
1874 :     # 1137998 date
1875 :     # 192276 db
1876 :     # 944705 first
1877 :     # 428 institute
1878 :     # 944615 last
1879 :     # 945315 name
1880 :     # 195 number
1881 :     # 1492 publisher
1882 :     # 1138598 type
1883 :     # 943275 volume
1884 :     # subelements:
1885 :     # 1138598 authorList
1886 :     # 935757 dbReference
1887 :     # 1363 editorList
1888 :     # 606 locator
1889 :     # 1068517 title
1890 :     #
1891 :     # entry.reference.citation.authorList
1892 :     # subelements:
1893 :     # 128353 consortium
1894 :     # 1060019 person
1895 :     #
1896 :     # entry.reference.citation.authorList.consortium
1897 :     # attributes:
1898 :     # 128438 name
1899 :     #
1900 :     # entry.reference.citation.authorList.person
1901 :     # attributes:
1902 :     # 24333701 name
1903 :     #
1904 :     # entry.reference.citation.dbReference
1905 :     # attributes:
1906 :     # 1806240 id
1907 :     # 1806240 type
1908 :     #
1909 :     # entry.reference.citation.editorList
1910 :     # subelements:
1911 :     # 1363 person
1912 :     #
1913 :     # entry.reference.citation.editorList.person
1914 :     # attributes:
1915 :     # 5385 name
1916 :     #
1917 :     # entry.reference.citation.locator
1918 :     # attributes:
1919 :     # 606 _
1920 :     #
1921 :     # entry.reference.citation.title
1922 :     # attributes:
1923 :     # 1068517 _
1924 :     #
1925 :     # entry.reference.scope
1926 :     # attributes:
1927 :     # 1501489 _
1928 :     #
1929 :     # entry.reference.source
1930 :     # subelements:
1931 :     # 1537 plasmid
1932 :     # 618305 strain
1933 :     # 168867 tissue
1934 :     # 162 transposon
1935 :     #
1936 :     # entry.reference.source.plasmid
1937 :     # attributes:
1938 :     # 1600 _
1939 :     #
1940 :     # entry.reference.source.strain
1941 :     # attributes:
1942 :     # 638006 _
1943 :     # 6453 evidence
1944 :     #
1945 :     # entry.reference.source.tissue
1946 :     # attributes:
1947 :     # 229032 _
1948 :     # 7923 evidence
1949 :     #
1950 :     # entry.reference.source.transposon
1951 :     # attributes:
1952 :     # 162 _
1953 :     #
1954 :    
1955 :     sub references
1956 :     {
1957 :     my @refs;
1958 :     foreach my $ref ( @{ reference_elements( @_ ) } )
1959 :     {
1960 :     my $key = $ref->{ key };
1961 :    
1962 :     my $cit = $ref->{ citation }->[0];
1963 :    
1964 :     my $type = $cit->{ type }; # book | journal article | online journal article | patent | submission | thesis | unpublished observations
1965 :    
1966 :     my @auth = nameList( $cit->{ authorList } );
1967 :     my $date = $cit->{ date };
1968 :     my $title = $cit->{ title } ? $cit->{ title }->[0]->{_} : undef;
1969 :    
1970 :     my $name = $cit->{ name };
1971 :     my $volume = $cit->{ volume };
1972 :     my $first = $cit->{ first };
1973 :     my $last = $cit->{ last };
1974 :     my $pages = $first ? $first . ( $last ? "-$last" : '' ) : '';
1975 :    
1976 :     # Book data
1977 :     my @eds = nameList( $cit->{ editorList } );
1978 :     my $publisher = $cit->{ publisher };
1979 :     my $city = $cit->{ city };
1980 :    
1981 :     # Database source of 'submission' citation
1982 :     my $db = $cit->{ db };
1983 :    
1984 :     # Patent number
1985 :     my $number = $cit->{ number };
1986 :    
1987 :     # Thesis data
1988 :     my $institute = $cit->{ institute };
1989 :     my $country = $cit->{ country };
1990 :    
1991 :     # On-line article
1992 :     my $url = $cit->{ locator } ? $cit->{ locator }->[0]->{_} : undef;
1993 :    
1994 :     # Citation cross references: ( [ $db, $id ], ... )
1995 :     my @xref = xref2( $cit );
1996 :    
1997 :     my $citation = { ( @auth ? ( auth => \@auth ) : () ),
1998 :     ( $city ? ( city => $city ) : () ),
1999 :     ( $country ? ( country => $country ) : () ),
2000 :     ( $date ? ( date => $date ) : () ),
2001 :     ( $db ? ( db => $db ) : () ),
2002 :     ( @eds ? ( eds => \@eds ) : () ),
2003 :     ( $institute ? ( institute => $institute ) : () ),
2004 :     ( $name ? ( name => $name ) : () ),
2005 :     ( $number ? ( number => $number ) : () ),
2006 :     ( $pages ? ( pages => $pages ) : () ),
2007 :     ( $publisher ? ( publisher => $publisher ) : () ),
2008 :     ( $title ? ( title => $title ) : () ),
2009 :     ( $type ? ( type => $type ) : () ),
2010 :     ( $url ? ( url => $url ) : () ),
2011 :     ( $volume ? ( volume => $volume ) : () ),
2012 :     ( @xref ? ( xref => \@xref ) : () ),
2013 :     };
2014 :    
2015 :     # Data provided in reference
2016 :     my $scope = join '; ', map { $_->{_} } @{ $ref->{ scope } };
2017 :    
2018 :     # Source of protein (e.g. organism strains covered)
2019 :     my $source = ( $ref->{ source } || [] )->[0] || {};
2020 :     my @source;
2021 :     push @source, map { "strain $_" } @{ $source->{ strain } || [] };
2022 :     push @source, map { "plasmid $_" } @{ $source->{ plasmid } || [] };
2023 :     push @source, map { "transposon $_" } @{ $source->{ transposon } || [] };
2024 :     push @source, map { "tissue: $_" } @{ $source->{ tissue } || [] };
2025 :    
2026 :     my $evidence = $ref->{ evidence } || '';
2027 :    
2028 :     push @refs, [ $key, $citation, $scope, \@source, $evidence ];
2029 :     }
2030 :    
2031 :     wantarray ? @refs : \@refs;
2032 :     }
2033 :    
2034 :    
2035 :     # <xs:complexType name="nameListType">
2036 :     # <xs:choice maxOccurs="unbounded">
2037 :     # <xs:element name="consortium" type="consortiumType"/>
2038 :     # <xs:element name="person" type="personType"/>
2039 :     # </xs:choice>
2040 :     # </xs:complexType>
2041 :     #
2042 :     # <!-- Describes the authors of a citation when these are represented by a consortium. Equivalent to the flat file RG-line. -->
2043 :     # <xs:complexType name="consortiumType"/>
2044 :     # <xs:attribute name="name" type="xs:string" use="required">
2045 :     # </xs:complexType>
2046 :     #
2047 :     # <xs:complexType name="personType">
2048 :     # <xs:attribute name="name" type="xs:string" use="required"/>
2049 :     # </xs:complexType>
2050 :     #
2051 :     sub nameList
2052 :     {
2053 :     $_[0] ? map { $_->{ name } }
2054 :     map { @{ $_->{ person } || [] }, @{ $_->{ consortium } || [] } }
2055 :     @{ $_[0] }
2056 :     : ();
2057 :     }
2058 :    
2059 :    
2060 :     #-------------------------------------------------------------------------------
2061 :     # Comment data
2062 :     #
2063 :     # Comments come in specific types, with very few shared attributes or
2064 :     # elements. Thus, nearly all access routines are type specific, but
2065 :     # even then, they are clumsy.
2066 :     #-------------------------------------------------------------------------------
2067 :     # Top-level access returns unmodified elements.
2068 :     #
2069 :     # @typed_comments = comments( $entry )
2070 :     # /@typed_comments = comments( $entry )
2071 :     #
2072 :     # where:
2073 :     #
2074 :     # $typed_comment = [ $type, $comment_element ];
2075 :     #
2076 :     # Direct extractor for particular comment type in an entry
2077 :     #
2078 :     # @comment_elements_of_type = comments_of_type( $entry, $type )
2079 :     #
2080 :     # $comment_elements = comment_elements( $entry );
2081 :     # @comment_elements_of_type = filter_comments( $comment_elements, $type );
2082 :     #
2083 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2084 :    
2085 :     sub comments_of_type
2086 :     {
2087 :     my @comments = grep { $_->{ type } eq $_[1] } @{ comment_elements( $_[0] ) };
2088 :     wantarray ? @comments : \@comments;
2089 :     }
2090 :    
2091 :    
2092 :     sub filter_comments
2093 :     {
2094 :     my @comments = grep { $_->{ type } eq $_[1] } @{ $_[0] };
2095 :     wantarray ? @comments : \@comments;
2096 :     }
2097 :    
2098 :    
2099 :     sub comments
2100 :     {
2101 :     my @comments = map { [ $_->{ type }, $_ ] } @{ comment_elements( @_ ) };
2102 :    
2103 :     wantarray ? @comments : \@comments;
2104 :     }
2105 :    
2106 :     #-------------------------------------------------------------------------------
2107 :     # Comment data for individual types (or subtypes)
2108 :     #-------------------------------------------------------------------------------
2109 :     # All comments can have an evidence attribute.
2110 :     #
2111 :     # <xs:attribute name="evidence" type="intListType" use="optional"/>
2112 :     #
2113 :     #-------------------------------------------------------------------------------
2114 :     # absorbtion
2115 :     #
2116 :     # ( [ $data_type, $text, $evidence, $status ], ... ) = absorption( $entry );
2117 :     # [ [ $data_type, $text, $evidence, $status ], ... ] = absorption( $entry );
2118 :     #
2119 :     # $data_type is max or note.
2120 :     #
2121 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2122 :     #
2123 :     # entry.comment/biophysicochemical properties
2124 :     # attributes:
2125 :     # 6929 type
2126 :     # subelements:
2127 :     # 138 absorption
2128 :     # 5250 kinetics
2129 :     # 3394 phDependence
2130 :     # 104 redoxPotential
2131 :     # 2002 temperatureDependence
2132 :     #
2133 :     # entry.comment/biophysicochemical properties.absorption
2134 :     # subelements:
2135 :     # 138 max
2136 :     # 45 text
2137 :     #
2138 :     # entry.comment/biophysicochemical properties.absorption.max
2139 :     # attributes:
2140 :     # 138 _
2141 :     # 56 evidence
2142 :     #
2143 :     # entry.comment/biophysicochemical properties.absorption.text
2144 :     # attributes:
2145 :     # 45 _
2146 :     # 12 evidence
2147 :     #
2148 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2149 :    
2150 :     sub absorption
2151 :     {
2152 :     my @biophys;
2153 :     foreach ( comments_of_type( $_[0], 'biophysicochemical properties' ) )
2154 :     {
2155 :     if ( $_->{ absorption } )
2156 :     {
2157 :     foreach ( @{ $_->{ absorption } } )
2158 :     {
2159 :     push @biophys, map { [ 'max', evidenced_string( $_ ) ] }
2160 :     @{ $_->{ max } || [] };
2161 :     push @biophys, map { [ 'note', evidenced_string( $_ ) ] }
2162 :     @{ $_->{ text } || [] };
2163 :     }
2164 :     }
2165 :     }
2166 :    
2167 :     wantarray ? @biophys : \@biophys;
2168 :     }
2169 :    
2170 :     #-------------------------------------------------------------------------------
2171 :     # allergen:
2172 :     #
2173 :     # ( $text_evid_stat, ... ) = allergen( $entry );
2174 :     # [ $text_evid_stat, ... ] = allergen( $entry );
2175 :     #
2176 :     # $text_evid_stat = [ $text, $evidence, $status ]
2177 :     #
2178 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2179 :     #
2180 :     # entry.comment/allergen
2181 :     # attributes:
2182 :     # 692 type
2183 :     # subelements:
2184 :     # 692 text
2185 :     #
2186 :     # entry.comment/allergen.text
2187 :     # attributes:
2188 :     # 692 _
2189 :     # 272 evidence
2190 :     # 21 status
2191 :     #
2192 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2193 :    
2194 :     sub allergen
2195 :     {
2196 :     my @allergen;
2197 :     foreach ( comments_of_type( $_[0], 'allergen' ) )
2198 :     {
2199 :     push @allergen, map { scalar evidenced_string( $_ ) }
2200 :     @{ $_->{ text } || [] };
2201 :     }
2202 :    
2203 :     wantarray ? @allergen : \@allergen;
2204 :     }
2205 :    
2206 :    
2207 :     #-------------------------------------------------------------------------------
2208 :     # alternative products:
2209 :     #
2210 :     # ( [ \@events, \@isoforms, \@text_evid_stat ], ... ) = alt_product( $entry )
2211 :     # [ [ \@events, \@isoforms, \@text_evid_stat ], ... ] = alt_product( $entry )
2212 :     #
2213 :     # @events is one or more of: alternative initiation | alternative promoter
2214 :     # | alternative splicing | ribosomal frameshifting
2215 :     #
2216 :     # @isoforms = ( [ $id, $name, $type, $ref, \@text_evid_stat ], ... )
2217 :     #
2218 :     # $id is a string of the form $acc-\d+, providing an identifier for
2219 :     # each isoform, based on the accession number. $acc-1 is the
2220 :     # sequence displayed in the entry.
2221 :     #
2222 :     # $name is a name from the literature, or the index number from the id.
2223 :     #
2224 :     # $type is one or more of: displayed | described | external | not described
2225 :     #
2226 :     # $ref is a string with zero or more feature ids defining the variant.
2227 :     #
2228 :     # @text_evid_stat is ( [ $note, $evidence, $status ], ... )
2229 :     #
2230 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2231 :     #
2232 :     # entry.comment/alternative products
2233 :     # attributes:
2234 :     # 24488 type
2235 :     # subelements:
2236 :     # 24488 event
2237 :     # 24488 isoform
2238 :     # 2947 text
2239 :     #
2240 :     # entry.comment/alternative products.event
2241 :     # attributes:
2242 :     # 24835 type
2243 :     #
2244 :     # entry.comment/alternative products.isoform
2245 :     # subelements:
2246 :     # 66065 id
2247 :     # 66065 name
2248 :     # 66065 sequence
2249 :     # 22339 text
2250 :     #
2251 :     # entry.comment/alternative products.isoform.id
2252 :     # attributes:
2253 :     # 66303 _
2254 :     #
2255 :     # entry.comment/alternative products.isoform.name
2256 :     # attributes:
2257 :     # 81640 _
2258 :     # 3630 evidence
2259 :     #
2260 :     # entry.comment/alternative products.isoform.sequence
2261 :     # attributes:
2262 :     # 39079 ref
2263 :     # 66065 type
2264 :     #
2265 :     # entry.comment/alternative products.isoform.text
2266 :     # attributes:
2267 :     # 22339 _
2268 :     # 2682 evidence
2269 :     #
2270 :     # entry.comment/alternative products.text
2271 :     # attributes:
2272 :     # 2947 _
2273 :     # 227 evidence
2274 :     #
2275 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2276 :    
2277 :     sub alt_product
2278 :     {
2279 :     my @alt_product;
2280 :     foreach ( comments_of_type( $_[0], 'alternative products' ) )
2281 :     {
2282 :     my @events = map { $_->{ type } ? $_->{ type } : () }
2283 :     @{ $_->{ event } || [] };
2284 :    
2285 :     my @isoforms = map { scalar isoform( $_ ) }
2286 :     @{ $_->{ isoform } || [] };
2287 :    
2288 :     my @text = map { scalar evidenced_string( $_ ) }
2289 :     @{ $_->{ text } || [] };
2290 :    
2291 :     push @alt_product, [ \@events, \@isoforms, \@text ];
2292 :     }
2293 :    
2294 :     wantarray ? @alt_product : \@alt_product;
2295 :     }
2296 :    
2297 :    
2298 :     sub isoform
2299 :     {
2300 :     my $iso = $_[0];
2301 :    
2302 :     my $id = ( ( $iso->{ id } || [] )->[0] || {} )->{_};
2303 :     my $name = ( ( $iso->{ name } || [] )->[0] || {} )->{_};
2304 :     my $seqH = ( $iso->{ sequence } || [] )->[0] || {};
2305 :     my $type = $seqH->{ type };
2306 :     my $ref = $seqH->{ ref };
2307 :     my @text = map { scalar evidenced_string( $_ ) }
2308 :     @{ $iso->{ text } || [] };
2309 :    
2310 :     my @iso = ( $id, $name, $type, $ref, \@text );
2311 :    
2312 :     wantarray ? @iso : \@iso;
2313 :     }
2314 :    
2315 :    
2316 :     #-------------------------------------------------------------------------------
2317 :     # biotechnology:
2318 :     #
2319 :     # ( $text_evid_stat, ... ) = biotechnology( $entry );
2320 :     # [ $text_evid_stat, ... ] = biotechnology( $entry );
2321 :     #
2322 :     # $text_evid_stat = [ $text, $evidence, $status ]
2323 :     #
2324 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2325 :     #
2326 :     # entry.comment/biotechnology
2327 :     # attributes:
2328 :     # 480 type
2329 :     # subelements:
2330 :     # 480 text
2331 :     #
2332 :     # entry.comment/biotechnology.text
2333 :     # attributes:
2334 :     # 480 _
2335 :     # 263 evidence
2336 :     #
2337 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2338 :    
2339 :     sub biotechnology
2340 :     {
2341 :     my @biotechnology;
2342 :     foreach ( comments_of_type( $_[0], 'biotechnology' ) )
2343 :     {
2344 :     push @biotechnology, map { scalar evidenced_string( $_ ) }
2345 :     @{ $_->{ text } || [] };
2346 :     }
2347 :    
2348 :     wantarray ? @biotechnology : \@biotechnology;
2349 :     }
2350 :    
2351 :    
2352 :     #-------------------------------------------------------------------------------
2353 :     # catalytic activity:
2354 :     #
2355 :     # ( $text_evid_stat, ... ) = catalytic_activity( $entry );
2356 :     # [ $text_evid_stat, ... ] = catalytic_activity( $entry );
2357 :     #
2358 :     # $text_evid_stat = [ $text, $evidence, $status ]
2359 :     #
2360 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2361 :     #
2362 :     # entry.comment/catalytic activity
2363 :     # attributes:
2364 :     # 257284 type
2365 :     # subelements:
2366 :     # 257284 text
2367 :     #
2368 :     # entry.comment/catalytic activity.text
2369 :     # attributes:
2370 :     # 257284 _
2371 :     # 204672 evidence
2372 :     #
2373 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2374 :    
2375 :     sub catalytic_activity
2376 :     {
2377 :     my @activity;
2378 :     foreach ( comments_of_type( $_[0], 'catalytic activity' ) )
2379 :     {
2380 :     push @activity, map { scalar evidenced_string( $_ ) }
2381 :     @{ $_->{ text } || [] };
2382 :     }
2383 :    
2384 :     wantarray ? @activity : \@activity;
2385 :     }
2386 :    
2387 :    
2388 :     #-------------------------------------------------------------------------------
2389 :     # caution:
2390 :     #
2391 :     # ( $text_evid_stat, ... ) = caution( $entry );
2392 :     # [ $text_evid_stat, ... ] = caution( $entry );
2393 :     #
2394 :     # $text_evid_stat = [ $text, $evidence, $status ]
2395 :     #
2396 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2397 :     #
2398 :     # entry.comment/caution
2399 :     # attributes:
2400 :     # 10352 type
2401 :     # subelements:
2402 :     # 10352 text
2403 :     #
2404 :     # entry.comment/caution.text
2405 :     # attributes:
2406 :     # 10352 _
2407 :     # 10337 evidence
2408 :     #
2409 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2410 :    
2411 :     sub caution
2412 :     {
2413 :     my @caution;
2414 :     foreach ( comments_of_type( $_[0], 'caution' ) )
2415 :     {
2416 :     push @caution, map { scalar evidenced_string( $_ ) }
2417 :     @{ $_->{ text } || [] };
2418 :     }
2419 :    
2420 :     wantarray ? @caution : \@caution;
2421 :     }
2422 :    
2423 :    
2424 :     #-------------------------------------------------------------------------------
2425 :     # cofactor:
2426 :     #
2427 :     # ( [ \@cofactors, $text_evid_stat, $molecule ], ... ) = cofactor( $entry )
2428 :     # [ [ \@cofactors, $text_evid_stat, $molecule ], ... ] = cofactor( $entry )
2429 :     #
2430 :     # @cofactors = ( [ $name, $xref_db, $xref_id, $evidence ], ... )
2431 :     # $text_evid_stat = [ $text, $evidence, $status ]
2432 :     # $evidence is a string of keys to evidence elements in the entry.
2433 :     # $status is a qualifier indicating projection or uncertainty.
2434 :     #
2435 :     # There is no obvious consistency in terms of lumping all cofactors into one
2436 :     # cofactor comment with multiple cofactors, or distributing them among
2437 :     # multiple comments.
2438 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2439 :     #
2440 :     # entry.comment/cofactor
2441 :     # attributes:
2442 :     # 118705 type
2443 :     # subelements:
2444 :     # 117578 cofactor
2445 :     # 18 molecule
2446 :     # 81832 text
2447 :     #
2448 :     # entry.comment/cofactor.cofactor
2449 :     # attributes:
2450 :     # 124567 evidence
2451 :     # subelements:
2452 :     # 129046 dbReference
2453 :     # 129046 name
2454 :     #
2455 :     # entry.comment/cofactor.cofactor.dbReference
2456 :     # attributes:
2457 :     # 129046 id
2458 :     # 129046 type
2459 :     #
2460 :     # entry.comment/cofactor.cofactor.name
2461 :     # attributes:
2462 :     # 129046 _
2463 :     #
2464 :     # entry.comment/cofactor.molecule
2465 :     # attributes:
2466 :     # 18 _
2467 :     #
2468 :     # entry.comment/cofactor.text
2469 :     # attributes:
2470 :     # 81832 _
2471 :     # 79528 evidence
2472 :     #
2473 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2474 :    
2475 :     sub cofactor
2476 :     {
2477 :     my @cofactor;
2478 :     foreach ( comments_of_type( $_[0], 'cofactor' ) )
2479 :     {
2480 :     my @cof;
2481 :     foreach ( @{ $_->{ cofactor } || [] } )
2482 :     {
2483 :     my $name = ( ( $_->{ name } || [] )->[0] || {} )->{_};
2484 :     # There is only one xref, and it is always ChEBI.
2485 :     my @xref = xref2( $_ );
2486 :     my $evidence = $_->{ evidence };
2487 :     push @cof, [ $name, @xref, $evidence ];
2488 :     }
2489 :    
2490 :     # I have not found any cases of multiple text elements, so just take the first.
2491 :     my $text = $_->{ text } ? scalar evidenced_string( $_->{ text }->[0] ) : undef;
2492 :     my $molecule = ( ( $_->{ molecule } || [] )->[0] || {} )->{_};
2493 :    
2494 :     push @cofactor, [ \@cof, $text, $molecule ];
2495 :     }
2496 :    
2497 :     wantarray ? @cofactor : \@cofactor;
2498 :     }
2499 :    
2500 :    
2501 :     #-------------------------------------------------------------------------------
2502 :     # developmental stage:
2503 :     #
2504 :     # ( $text_evid_stat, ... ) = developmental_stage( $entry );
2505 :     # [ $text_evid_stat, ... ] = developmental_stage( $entry );
2506 :     #
2507 :     # $text_evid_stat = [ $text, $evidence, $status ]
2508 :     #
2509 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2510 :     #
2511 :     # entry.comment/developmental stage
2512 :     # attributes:
2513 :     # 10854 type
2514 :     # subelements:
2515 :     # 10854 text
2516 :     #
2517 :     # entry.comment/developmental stage.text
2518 :     # attributes:
2519 :     # 10854 _
2520 :     # 7821 evidence
2521 :     #
2522 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2523 :    
2524 :     sub developmental_stage
2525 :     {
2526 :     my @stage;
2527 :     foreach ( comments_of_type( $_[0], 'developmental stage' ) )
2528 :     {
2529 :     push @stage, map { scalar evidenced_string( $_ ) }
2530 :     @{ $_->{ text } || [] };
2531 :     }
2532 :    
2533 :     wantarray ? @stage : \@stage;
2534 :     }
2535 :    
2536 :    
2537 :     #-------------------------------------------------------------------------------
2538 :     # disease:
2539 :     #
2540 :     # ( [ $id, $name, $acronym, $desc, \@xref, $text_evid_stat, $evidence ], ... ] = disease( $entry );
2541 :     # [ [ $id, $name, $acronym, $desc, \@xref, $text_evid_stat, $evidence ], ... ] = disease( $entry );
2542 :     #
2543 :     # @xref = ( [ $db, $id ], ... )
2544 :     # $text_evid_stat = [ $text, $evidence, $status ]
2545 :     #
2546 :     # The first 5 fields are formally tied to a disease; the 6th and 7th are
2547 :     # more flexible.
2548 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2549 :     #
2550 :     # entry.comment/disease
2551 :     # attributes:
2552 :     # 4726 evidence
2553 :     # 6165 type
2554 :     # subelements:
2555 :     # 4906 disease
2556 :     # 6165 text
2557 :     #
2558 :     # entry.comment/disease.disease
2559 :     # attributes:
2560 :     # 4906 id
2561 :     # subelements:
2562 :     # 4906 acronym
2563 :     # 4906 dbReference
2564 :     # 4906 description
2565 :     # 4906 name
2566 :     #
2567 :     # entry.comment/disease.disease.acronym
2568 :     # attributes:
2569 :     # 4906 _
2570 :     #
2571 :     # entry.comment/disease.disease.dbReference
2572 :     # attributes:
2573 :     # 4906 id
2574 :     # 4906 type
2575 :     #
2576 :     # entry.comment/disease.disease.description
2577 :     # attributes:
2578 :     # 4906 _
2579 :     #
2580 :     # entry.comment/disease.disease.name
2581 :     # attributes:
2582 :     # 4906 _
2583 :     #
2584 :     # entry.comment/disease.text
2585 :     # attributes:
2586 :     # 6165 _
2587 :     # 959 evidence
2588 :     #
2589 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2590 :    
2591 :     sub disease
2592 :     {
2593 :     my @disease;
2594 :     foreach ( comments_of_type( $_[0], 'disease' ) )
2595 :     {
2596 :     my $text = $_->{ text }->[0] ? evidenced_string( $_->{ text }->[0] ) : '';
2597 :     my $evidence = $_->{ evidence };
2598 :    
2599 :     push @disease, [ get_disease( $_ ), $text, $evidence ];
2600 :     }
2601 :    
2602 :     wantarray ? @disease : \@disease;
2603 :     }
2604 :    
2605 :    
2606 :     sub get_disease
2607 :     {
2608 :     local $_ = shift;
2609 :     my @data;
2610 :     if ( $_->{ disease } )
2611 :     {
2612 :     my $disease = $_->{ disease }->[0];
2613 :     my $id = $disease->{ id };
2614 :     my $name = ( ( $disease->{ name } || [] )->[0] || {} )->{_};
2615 :     my $acro = ( ( $disease->{ acronym } || [] )->[0] || {} )->{_};
2616 :     my $desc = ( ( $disease->{ description } || [] )->[0] || {} )->{_};
2617 :     my @xref = xref2( $disease );
2618 :     @data = ( $id, $name, $acro, $desc, \@xref );
2619 :     }
2620 :     else
2621 :     {
2622 :     @data = ( undef, undef, undef, undef, [] );
2623 :     }
2624 :    
2625 :     wantarray ? @data : \@data;
2626 :     }
2627 :    
2628 :    
2629 :     #-------------------------------------------------------------------------------
2630 :     # disruption phenotype:
2631 :     #
2632 :     # ( $text_evid_stat, ... ) = disruption_phenotype( $entry );
2633 :     # [ $text_evid_stat, ... ] = disruption_phenotype( $entry );
2634 :     #
2635 :     # $text_evid_stat = [ $text, $evidence, $status ]
2636 :     #
2637 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2638 :     #
2639 :     # entry.comment/disruption phenotype
2640 :     # attributes:
2641 :     # 9856 type
2642 :     # subelements:
2643 :     # 9856 text
2644 :     #
2645 :     # entry.comment/disruption phenotype.text
2646 :     # attributes:
2647 :     # 9856 _
2648 :     # 9843 evidence
2649 :     #
2650 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2651 :    
2652 :     sub disruption_phenotype
2653 :     {
2654 :     my @phenotype;
2655 :     foreach ( comments_of_type( $_[0], 'disruption phenotype' ) )
2656 :     {
2657 :     push @phenotype, map { scalar evidenced_string( $_ ) }
2658 :     @{ $_->{ text } || [] };
2659 :     }
2660 :    
2661 :     wantarray ? @phenotype : \@phenotype;
2662 :     }
2663 :    
2664 :    
2665 :     #-------------------------------------------------------------------------------
2666 :     # domain (these are domains in the protein structure)
2667 :     #
2668 :     # ( $text_evid_stat, ... ) = domain( $entry );
2669 :     # [ $text_evid_stat, ... ] = domain( $entry );
2670 :     #
2671 :     # $text_evid_stat = [ $text, $evidence, $status ]
2672 :     #
2673 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2674 :     #
2675 :     # entry.comment/domain
2676 :     # attributes:
2677 :     # 44021 type
2678 :     # subelements:
2679 :     # 44021 text
2680 :     #
2681 :     # entry.comment/domain.text
2682 :     # attributes:
2683 :     # 44021 _
2684 :     # 32228 evidence
2685 :     # 4124 status
2686 :     #
2687 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2688 :    
2689 :     sub domain
2690 :     {
2691 :     my @domain;
2692 :     foreach ( comments_of_type( $_[0], 'domain' ) )
2693 :     {
2694 :     push @domain, map { scalar evidenced_string( $_ ) }
2695 :     @{ $_->{ text } || [] };
2696 :     }
2697 :    
2698 :     wantarray ? @domain : \@domain;
2699 :     }
2700 :    
2701 :    
2702 :     #-------------------------------------------------------------------------------
2703 :     # enzyme regulation:
2704 :     #
2705 :     # ( $text_evid_stat, ... ) = enzyme_regulation( $entry );
2706 :     # [ $text_evid_stat, ... ] = enzyme_regulation( $entry );
2707 :     #
2708 :     # $text_evid_stat = [ $text, $evidence, $status ]
2709 :     #
2710 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2711 :     #
2712 :     # entry.comment/enzyme regulation
2713 :     # attributes:
2714 :     # 13424 type
2715 :     # subelements:
2716 :     # 13424 text
2717 :     #
2718 :     # entry.comment/enzyme regulation.text
2719 :     # attributes:
2720 :     # 13424 _
2721 :     # 11567 evidence
2722 :     # 1193 status
2723 :     #
2724 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2725 :    
2726 :     sub enzyme_regulation
2727 :     {
2728 :     my @regulation;
2729 :     foreach ( comments_of_type( $_[0], 'enzyme regulation' ) )
2730 :     {
2731 :     push @regulation, map { scalar evidenced_string( $_ ) }
2732 :     @{ $_->{ text } || [] };
2733 :     }
2734 :    
2735 :     wantarray ? @regulation : \@regulation;
2736 :     }
2737 :    
2738 :    
2739 :     #-------------------------------------------------------------------------------
2740 :     # function:
2741 :     #
2742 :     # ( $text_evid_stat, ... ) = function_comment( $entry );
2743 :     # [ $text_evid_stat, ... ] = function_comment( $entry );
2744 :     #
2745 :     # $text_evid_stat = [ $text, $evidence, $status ]
2746 :     #
2747 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2748 :     #
2749 :     # entry.comment/function
2750 :     # attributes:
2751 :     # 445858 type
2752 :     # subelements:
2753 :     # 445858 text
2754 :     #
2755 :     # entry.comment/function.text
2756 :     # attributes:
2757 :     # 445858 _
2758 :     # 404444 evidence
2759 :     # 55366 status
2760 :     #
2761 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2762 :    
2763 :     sub function_comment
2764 :     {
2765 :     my @function;
2766 :     foreach ( comments_of_type( $_[0], 'function' ) )
2767 :     {
2768 :     push @function, map { scalar evidenced_string( $_ ) }
2769 :     @{ $_->{ text } || [] };
2770 :     }
2771 :    
2772 :     wantarray ? @function : \@function;
2773 :     }
2774 :    
2775 :    
2776 :     #-------------------------------------------------------------------------------
2777 :     # induction:
2778 :     #
2779 :     # ( $text_evid_stat, ... ) = induction( $entry );
2780 :     # [ $text_evid_stat, ... ] = induction( $entry );
2781 :     #
2782 :     # $text_evid_stat = [ $text, $evidence, $status ]
2783 :     #
2784 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2785 :     #
2786 :     # entry.comment/induction
2787 :     # attributes:
2788 :     # 17969 type
2789 :     # subelements:
2790 :     # 17969 text
2791 :     #
2792 :     # entry.comment/induction.text
2793 :     # attributes:
2794 :     # 17969 _
2795 :     # 13925 evidence
2796 :     # 316 status
2797 :     #
2798 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2799 :    
2800 :     sub induction
2801 :     {
2802 :     my @induction;
2803 :     foreach ( comments_of_type( $_[0], 'induction' ) )
2804 :     {
2805 :     push @induction, map { scalar evidenced_string( $_ ) }
2806 :     @{ $_->{ text } || [] };
2807 :     }
2808 :    
2809 :     wantarray ? @induction : \@induction;
2810 :     }
2811 :    
2812 :    
2813 :     #-------------------------------------------------------------------------------
2814 :     # interaction:
2815 :     #
2816 :     # ( [ \@interactants, $orgs_differ, $n_exper ], ... ) = interaction( $entry )
2817 :     # [ [ \@interactants, $orgs_differ, $n_exper ], ... ] = interaction( $entry )
2818 :     #
2819 :     # @interactants = ( [ $intactId, $sp_acc, $label ], ... )
2820 :     # $intactId is an EBI identifier
2821 :     # $sp_acc is the Swiss-Prot accession number (when available)
2822 :     # $label is a protein identifier, mostly in genetic nomenclature
2823 :     # $orgs_differ is a boolean value that indicates heterologous species
2824 :     # $n_exper is the number of experiments supporting the interaction
2825 :     #
2826 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2827 :     #
2828 :     # entry.comment/interaction
2829 :     # attributes:
2830 :     # 61140 type
2831 :     # subelements:
2832 :     # 61140 experiments
2833 :     # 61140 interactant
2834 :     # 61140 organismsDiffer
2835 :     #
2836 :     # entry.comment/interaction.experiments
2837 :     # attributes:
2838 :     # 61140 _
2839 :     #
2840 :     # entry.comment/interaction.interactant
2841 :     # attributes:
2842 :     # 122280 intactId
2843 :     # subelements:
2844 :     # 60098 id
2845 :     # 59438 label
2846 :     #
2847 :     # entry.comment/interaction.interactant.id
2848 :     # attributes:
2849 :     # 60098 _
2850 :     #
2851 :     # entry.comment/interaction.interactant.label
2852 :     # attributes:
2853 :     # 59438 _
2854 :     #
2855 :     # entry.comment/interaction.organismsDiffer
2856 :     # attributes:
2857 :     # 61140 _
2858 :     #
2859 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2860 :    
2861 :     sub interaction
2862 :     {
2863 :     my @interact;
2864 :     foreach ( comments_of_type( $_[0], 'interaction' ) )
2865 :     {
2866 :     my @interactants = map { scalar interactant( $_ ) }
2867 :     @{ $_->{ interactant } };
2868 :     my $orgDiffer = ( $_->{ organismsDiffer } || [ 'false ' ] )->[0] eq 'true';
2869 :     my $exper = ( $_->{ experiments } || [] )->[0];
2870 :     push @interact, [ \@interactants, $orgDiffer, $exper ];
2871 :     }
2872 :    
2873 :     wantarray ? @interact : \@interact;
2874 :     }
2875 :    
2876 :    
2877 :     sub interactant
2878 :     {
2879 :     local $_ = shift;
2880 :     my $intId = $_->{ intactId };
2881 :     my $id = ( $_->{ id } || [] )->[0];
2882 :     my $label = ( $_->{ label } || [] )->[0];
2883 :    
2884 :     wantarray ? ( $intId, $id, $label )
2885 :     : [ $intId, $id, $label ];
2886 :     }
2887 :    
2888 :    
2889 :     #-------------------------------------------------------------------------------
2890 :     # kinetics:
2891 :     #
2892 :     # ( [ $measurement, $text, $evidence, $status ], ... ) = kinetics( $entry )
2893 :     # [ [ $measurement, $text, $evidence, $status ], ... ] = kinetics( $entry )
2894 :     #
2895 :     # Measurement is 1 of: KM | Vmax | note
2896 :     #
2897 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2898 :     #
2899 :     # entry.comment/biophysicochemical properties
2900 :     # attributes:
2901 :     # 6929 type
2902 :     # subelements:
2903 :     # 138 absorption
2904 :     # 5250 kinetics
2905 :     # 3394 phDependence
2906 :     # 104 redoxPotential
2907 :     # 2002 temperatureDependence
2908 :     #
2909 :     # entry.comment/biophysicochemical properties.kinetics
2910 :     # subelements:
2911 :     # 5036 KM
2912 :     # 1517 text
2913 :     # 1953 Vmax
2914 :     #
2915 :     # entry.comment/biophysicochemical properties.kinetics.KM
2916 :     # attributes:
2917 :     # 14377 _
2918 :     # 13913 evidence
2919 :     #
2920 :     # entry.comment/biophysicochemical properties.kinetics.text
2921 :     # attributes:
2922 :     # 1517 _
2923 :     # 618 evidence
2924 :     #
2925 :     # entry.comment/biophysicochemical properties.kinetics.Vmax
2926 :     # attributes:
2927 :     # 4687 _
2928 :     # 4529 evidence
2929 :     #
2930 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2931 :    
2932 :     sub kinetics
2933 :     {
2934 :     my @biophys;
2935 :     foreach ( comments_of_type( $_[0], 'biophysicochemical properties' ) )
2936 :     {
2937 :     if ( $_->{ kinetics } )
2938 :     {
2939 :     foreach ( @{ $_->{ kinetics } } )
2940 :     {
2941 :     push @biophys, map { [ 'KM', evidenced_string( $_ ) ] }
2942 :     @{ $_->{ KM } || [] };
2943 :     push @biophys, map { [ 'Vmax', evidenced_string( $_ ) ] }
2944 :     @{ $_->{ Vmax } || [] };
2945 :     push @biophys, map { [ 'note', evidenced_string( $_ ) ] }
2946 :     @{ $_->{ text } || [] };
2947 :     }
2948 :     }
2949 :     }
2950 :    
2951 :     wantarray ? @biophys : \@biophys;
2952 :     }
2953 :    
2954 :    
2955 :     #-------------------------------------------------------------------------------
2956 :     # mass spectrometry:
2957 :     #
2958 :     # ( [ $mass, $error, $method, $evidence, \@text_evid_stat ], ... ) = mass_spectrometry( $entry )
2959 :     # [ [ $mass, $error, $method, $evidence, \@text_evid_stat ], ... ] = mass_spectrometry( $entry )
2960 :     #
2961 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2962 :     #
2963 :     # entry.comment/mass spectrometry
2964 :     # attributes:
2965 :     # 1122 error
2966 :     # 6067 evidence
2967 :     # 6067 mass
2968 :     # 6067 method
2969 :     # 6067 type
2970 :     # subelements:
2971 :     # 6067 location
2972 :     # 1195 text
2973 :     #
2974 :     # entry.comment/mass spectrometry.location
2975 :     # attributes:
2976 :     # 57 sequence
2977 :     # subelements:
2978 :     # 6140 begin
2979 :     # 6140 end
2980 :     #
2981 :     # entry.comment/mass spectrometry.location.begin
2982 :     # attributes:
2983 :     # 6103 position
2984 :     # 37 status
2985 :     #
2986 :     # entry.comment/mass spectrometry.location.end
2987 :     # attributes:
2988 :     # 5764 position
2989 :     # 376 status
2990 :     #
2991 :     # entry.comment/mass spectrometry.text
2992 :     # attributes:
2993 :     # 1195 _
2994 :     #
2995 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2996 :    
2997 :     sub mass_spectrometry
2998 :     {
2999 :     my @mass;
3000 :     foreach ( comments_of_type( $_[0], 'mass spectrometry' ) )
3001 :     {
3002 :     my $mass = $_->{ mass };
3003 :     my $error = $_->{ error };
3004 :     my $method = $_->{ method };
3005 :     my $evidence = $_->{ evidence };
3006 :     my @text = map { scalar evidenced_string( $_ ) }
3007 :     @{ $_->{ text } || [] };
3008 :     push @mass, [ $mass, $error, $method, $evidence, \@text ];
3009 :     }
3010 :    
3011 :     wantarray ? @mass : \@mass;
3012 :     }
3013 :    
3014 :    
3015 :     #-------------------------------------------------------------------------------
3016 :     # miscellaneous:
3017 :     #
3018 :     # ( $text_evid_stat, ... ) = misc_comment( $entry );
3019 :     # [ $text_evid_stat, ... ] = misc_comment( $entry );
3020 :     #
3021 :     # $text_evid_stat = [ $text, $evidence, $status ]
3022 :     #
3023 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3024 :     #
3025 :     # entry.comment/miscellaneous
3026 :     # attributes:
3027 :     # 35128 type
3028 :     # subelements:
3029 :     # 35128 text
3030 :     #
3031 :     # entry.comment/miscellaneous.text
3032 :     # attributes:
3033 :     # 35128 _
3034 :     # 18219 evidence
3035 :     # 1177 status
3036 :     #
3037 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3038 :    
3039 :     sub misc_comment
3040 :     {
3041 :     my @misc;
3042 :     foreach ( comments_of_type( $_[0], 'miscellaneous' ) )
3043 :     {
3044 :     push @misc, map { scalar evidenced_string( $_ ) }
3045 :     @{ $_->{ text } || [] };
3046 :     }
3047 :    
3048 :     wantarray ? @misc : \@misc;
3049 :     }
3050 :    
3051 :    
3052 :     #-------------------------------------------------------------------------------
3053 :     # online information:
3054 :     #
3055 :     # ( [ $name, $url, \@text_evid_stat ], ... ) = online_info( $entry );
3056 :     # [ [ $name, $url, \@text_evid_stat ], ... ] = online_info( $entry );
3057 :     #
3058 :     # @text_evid_stat = ( [ $text, $evidence, $status ], ... )
3059 :     #
3060 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3061 :     #
3062 :     # entry.comment/online information
3063 :     # attributes:
3064 :     # 8233 name
3065 :     # 8233 type
3066 :     # subelements:
3067 :     # 8233 link
3068 :     # 4136 text
3069 :     #
3070 :     # entry.comment/online information.link
3071 :     # attributes:
3072 :     # 8233 uri
3073 :     #
3074 :     # entry.comment/online information.text
3075 :     # attributes:
3076 :     # 4136 _
3077 :     #
3078 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3079 :    
3080 :     sub online_info
3081 :     {
3082 :     my @info;
3083 :     foreach ( comments_of_type( $_[0], 'online information' ) )
3084 :     {
3085 :     my $name = $_->{ name };
3086 :     my $url = $_->{ link }->[0]->{ url };
3087 :     my @text = map { scalar evidenced_string( $_ ) } @{ $_->{ text } || [] };
3088 :     push @info, [ $name, $url, \@text ];
3089 :     }
3090 :    
3091 :     wantarray ? @info : \@info;
3092 :     }
3093 :    
3094 :    
3095 :     #-------------------------------------------------------------------------------
3096 :     # pathway:
3097 :     #
3098 :     # ( $text_evid_stat, ... ) = pathway( $entry );
3099 :     # [ $text_evid_stat, ... ] = pathway( $entry );
3100 :     #
3101 :     # $text_evid_stat = [ $text, $evidence, $status ]
3102 :     #
3103 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3104 :     #
3105 :     # entry.comment/pathway
3106 :     # attributes:
3107 :     # 135385 type
3108 :     # subelements:
3109 :     # 135385 text
3110 :     #
3111 :     # entry.comment/pathway.text
3112 :     # attributes:
3113 :     # 135385 _
3114 :     # 111057 evidence
3115 :     #
3116 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3117 :    
3118 :     sub pathway
3119 :     {
3120 :     my @pathway;
3121 :     foreach ( comments_of_type( $_[0], 'pathway' ) )
3122 :     {
3123 :     push @pathway, map { scalar evidenced_string( $_ ) }
3124 :     @{ $_->{ text } || [] };
3125 :     }
3126 :    
3127 :     wantarray ? @pathway : \@pathway;
3128 :     }
3129 :    
3130 :    
3131 :     #-------------------------------------------------------------------------------
3132 :     # pharmaceutical:
3133 :     #
3134 :     # ( $text_evid_stat, ... ) = pharmaceutical( $entry );
3135 :     # [ $text_evid_stat, ... ] = pharmaceutical( $entry );
3136 :     #
3137 :     # $text_evid_stat = [ $text, $evidence, $status ]
3138 :     #
3139 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3140 :     #
3141 :     # entry.comment/pharmaceutical
3142 :     # attributes:
3143 :     # 99 type
3144 :     # subelements:
3145 :     # 99 text
3146 :     #
3147 :     # entry.comment/pharmaceutical.text
3148 :     # attributes:
3149 :     # 99 _
3150 :     # 4 evidence
3151 :     #
3152 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3153 :    
3154 :     sub pharmaceutical
3155 :     {
3156 :     my @pharmaceutical;
3157 :     foreach ( comments_of_type( $_[0], 'pharmaceutical' ) )
3158 :     {
3159 :     push @pharmaceutical, map { scalar evidenced_string( $_ ) }
3160 :     @{ $_->{ text } || [] };
3161 :     }
3162 :    
3163 :     wantarray ? @pharmaceutical : \@pharmaceutical;
3164 :     }
3165 :    
3166 :    
3167 :     #-------------------------------------------------------------------------------
3168 :     # pH_dependence:
3169 :     #
3170 :     # ( $text_evid_stat, ... ) = pH_dependence( $entry );
3171 :     # [ $text_evid_stat, ... ] = pH_dependence( $entry );
3172 :     #
3173 :     # $text_evid_stat = [ $text, $evidence, $status ]
3174 :     #
3175 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3176 :     #
3177 :     # entry.comment/biophysicochemical properties
3178 :     # attributes:
3179 :     # 6929 type
3180 :     # subelements:
3181 :     # 138 absorption
3182 :     # 5250 kinetics
3183 :     # 3394 phDependence
3184 :     # 104 redoxPotential
3185 :     # 2002 temperatureDependence
3186 :     #
3187 :     # entry.comment/biophysicochemical properties.phDependence
3188 :     # subelements:
3189 :     # 3394 text
3190 :     #
3191 :     # entry.comment/biophysicochemical properties.phDependence.text
3192 :     # attributes:
3193 :     # 3394 _
3194 :     # 2936 evidence
3195 :     #
3196 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3197 :    
3198 :     sub pH_dependence
3199 :     {
3200 :     my @biophys;
3201 :     foreach ( comments_of_type( $_[0], 'biophysicochemical properties' ) )
3202 :     {
3203 :     if ( $_->{ phDependence } )
3204 :     {
3205 :     foreach ( @{ $_->{ phDependence } } )
3206 :     {
3207 :     push @biophys, map { scalar evidenced_string( $_ ) }
3208 :     @{ $_->{ text } || [] };
3209 :     }
3210 :     }
3211 :     }
3212 :    
3213 :     wantarray ? @biophys : \@biophys;
3214 :     }
3215 :    
3216 :    
3217 :     #-------------------------------------------------------------------------------
3218 :     # polymorphism:
3219 :     #
3220 :     # ( $text_evid_stat, ... ) = polymorphism( $entry );
3221 :     # [ $text_evid_stat, ... ] = polymorphism( $entry );
3222 :     #
3223 :     # $text_evid_stat = [ $text, $evidence, $status ]
3224 :     #
3225 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3226 :     #
3227 :     # entry.comment/polymorphism
3228 :     # attributes:
3229 :     # 1045 type
3230 :     # subelements:
3231 :     # 1045 text
3232 :     #
3233 :     # entry.comment/polymorphism.text
3234 :     # attributes:
3235 :     # 1045 _
3236 :     # 508 evidence
3237 :     #
3238 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3239 :    
3240 :     sub polymorphism
3241 :     {
3242 :     my @polymorphism;
3243 :     foreach ( comments_of_type( $_[0], 'polymorphism' ) )
3244 :     {
3245 :     push @polymorphism, map { scalar evidenced_string( $_ ) }
3246 :     @{ $_->{ text } || [] };
3247 :     }
3248 :    
3249 :     wantarray ? @polymorphism : \@polymorphism;
3250 :     }
3251 :    
3252 :    
3253 :     #-------------------------------------------------------------------------------
3254 :     # PTM:
3255 :     #
3256 :     # ( $text_evid_stat, ... ) = PTM( $entry );
3257 :     # [ $text_evid_stat, ... ] = PTM( $entry );
3258 :     #
3259 :     # $text_evid_stat = [ $text, $evidence, $status ]
3260 :     #
3261 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3262 :     #
3263 :     # entry.comment/PTM
3264 :     # attributes:
3265 :     # 50662 type
3266 :     # subelements:
3267 :     # 50662 text
3268 :     #
3269 :     # entry.comment/PTM.text
3270 :     # attributes:
3271 :     # 50662 _
3272 :     # 44605 evidence
3273 :     # 9055 status
3274 :     #
3275 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3276 :    
3277 :     sub PTM
3278 :     {
3279 :     my @PTM;
3280 :     foreach ( comments_of_type( $_[0], 'PTM' ) )
3281 :     {
3282 :     push @PTM, map { scalar evidenced_string( $_ ) }
3283 :     @{ $_->{ text } || [] };
3284 :     }
3285 :    
3286 :     wantarray ? @PTM : \@PTM;
3287 :     }
3288 :    
3289 :    
3290 :     #-------------------------------------------------------------------------------
3291 :     # redox_potential:
3292 :     #
3293 :     # ( $text_evid_stat, ... ) = redox_potential( $entry );
3294 :     # [ $text_evid_stat, ... ] = redox_potential( $entry );
3295 :     #
3296 :     # $text_evid_stat = [ $text, $evidence, $status ]
3297 :     #
3298 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3299 :     #
3300 :     # entry.comment/biophysicochemical properties
3301 :     # attributes:
3302 :     # 6929 type
3303 :     # subelements:
3304 :     # 138 absorption
3305 :     # 5250 kinetics
3306 :     # 3394 phDependence
3307 :     # 104 redoxPotential
3308 :     # 2002 temperatureDependence
3309 :     #
3310 :     # entry.comment/biophysicochemical properties.redoxPotential
3311 :     # subelements:
3312 :     # 104 text
3313 :     #
3314 :     # entry.comment/biophysicochemical properties.redoxPotential.text
3315 :     # attributes:
3316 :     # 104 _
3317 :     # 40 evidence
3318 :     #
3319 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3320 :    
3321 :     sub redox_potential
3322 :     {
3323 :     my @biophys;
3324 :     foreach ( comments_of_type( $_[0], 'biophysicochemical properties' ) )
3325 :     {
3326 :     if ( $_->{ redoxPotential } )
3327 :     {
3328 :     foreach ( @{ $_->{ redoxPotential } } )
3329 :     {
3330 :     push @biophys, map { scalar evidenced_string( $_ ) }
3331 :     @{ $_->{ text } || [] };
3332 :     }
3333 :     }
3334 :     }
3335 :    
3336 :     wantarray ? @biophys : \@biophys;
3337 :     }
3338 :    
3339 :    
3340 :     #-------------------------------------------------------------------------------
3341 :     # RNA editing:
3342 :     #
3343 :     # ( $loc_text_evid_stat, ... ) = RNA_editing( $entry );
3344 :     # [ $loc_text_evid_stat, ... ] = RNA_editing( $entry );
3345 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3346 :     #
3347 :     # entry.comment/RNA editing
3348 :     # attributes:
3349 :     # 20 locationType
3350 :     # 627 type
3351 :     # subelements:
3352 :     # 607 location
3353 :     # 410 text
3354 :     #
3355 :     # entry.comment/RNA editing.location
3356 :     # subelements:
3357 :     # 2836 position
3358 :     #
3359 :     # entry.comment/RNA editing.location.position
3360 :     # attributes:
3361 :     # 2770 evidence
3362 :     # 2836 position
3363 :     #
3364 :     # entry.comment/RNA editing.text
3365 :     # attributes:
3366 :     # 410 _
3367 :     # 155 evidence
3368 :     #
3369 :     #
3370 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3371 :    
3372 :     sub RNA_editing
3373 :     {
3374 :     my @edits;
3375 :     foreach ( comments_of_type( $_[0], 'RNA editing' ) )
3376 :     {
3377 :     my $loc = $_->{ location } ? ftr_location( $_->{ location }->[0] )
3378 :     : $_->{ locationType };
3379 :     my @text = map { scalar evidenced_string( $_ ) }
3380 :     @{ $_->{ text } || [] };
3381 :     push @edits, [ $loc, \@text ];
3382 :     }
3383 :    
3384 :     wantarray ? @edits : \@edits;
3385 :     }
3386 :    
3387 :    
3388 :     #-------------------------------------------------------------------------------
3389 :     # sequence caution:
3390 :     #
3391 :     # ( [ $type, $db, $id, $version, $loc, \@text_evid_stat, $evidence ], ... ) = sequence_caution( $entry )
3392 :     # [ [ $type, $db, $id, $version, $loc, \@text_evid_stat, $evidence ], ... ] = sequence_caution( $entry )
3393 :     #
3394 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3395 :     #
3396 :     # entry.comment/sequence caution
3397 :     # attributes:
3398 :     # 59105 evidence
3399 :     # 59212 type
3400 :     # subelements:
3401 :     # 59212 conflict
3402 :     # 8173 location
3403 :     # 16649 text
3404 :     #
3405 :     # entry.comment/sequence caution.conflict
3406 :     # attributes:
3407 :     # 51 ref
3408 :     # 59212 type
3409 :     # subelements:
3410 :     # 59161 sequence
3411 :     #
3412 :     # entry.comment/sequence caution.conflict.sequence
3413 :     # attributes:
3414 :     # 59161 id
3415 :     # 59161 resource
3416 :     # 57930 version
3417 :     #
3418 :     # entry.comment/sequence caution.location
3419 :     # subelements:
3420 :     # 11889 position
3421 :     #
3422 :     # entry.comment/sequence caution.location.position
3423 :     # attributes:
3424 :     # 11889 position
3425 :     #
3426 :     # entry.comment/sequence caution.text
3427 :     # attributes:
3428 :     # 16649 _
3429 :     #
3430 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3431 :    
3432 :     sub sequence_caution
3433 :     {
3434 :     my @cautions;
3435 :     foreach ( comments_of_type( $_[0], 'sequence caution' ) )
3436 :     {
3437 :     my $evidence = $_->{ evidence };
3438 :    
3439 :     my $loc = $_->{ location } ? ftr_location( $_->{ location }->[0] )
3440 :     : undef;
3441 :    
3442 :     my @text = map { scalar evidenced_string( $_ ) }
3443 :     @{ $_->{ text } || [] };
3444 :    
3445 :     my $conflict = ( $_->{ conflict } || [] )->[0]
3446 :     or next;
3447 :     my $type = $conflict->{ type };
3448 :     my $sequence = ( $conflict->{ sequence } || [] )->[0] || {};
3449 :     my $resource = $sequence->{ resource };
3450 :     my $id = $sequence->{ id };
3451 :     my $version = $sequence->{ version };
3452 :    
3453 :     push @cautions, [ $type, $resource, $id, $version, $loc, \@text, $evidence ];
3454 :     }
3455 :    
3456 :     wantarray ? @cautions : \@cautions;
3457 :     }
3458 :    
3459 :    
3460 :     #-------------------------------------------------------------------------------
3461 :     # similarity:
3462 :     #
3463 :     # ( $text_evid_stat, ... ) = similarity( $entry );
3464 :     # [ $text_evid_stat, ... ] = similarity( $entry );
3465 :     #
3466 :     # $text_evid_stat = [ $text, $evidence, $status ]
3467 :     #
3468 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3469 :     #
3470 :     # entry.comment/similarity
3471 :     # attributes:
3472 :     # 666671 type
3473 :     # subelements:
3474 :     # 666671 text
3475 :     #
3476 :     # entry.comment/similarity.text
3477 :     # attributes:
3478 :     # 666671 _
3479 :     # 666553 evidence
3480 :     #
3481 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3482 :    
3483 :     sub similarity
3484 :     {
3485 :     my @similarity;
3486 :     foreach ( comments_of_type( $_[0], 'similarity' ) )
3487 :     {
3488 :     push @similarity, map { scalar evidenced_string( $_ ) }
3489 :     @{ $_->{ text } || [] };
3490 :     }
3491 :    
3492 :     wantarray ? @similarity : \@similarity;
3493 :     }
3494 :    
3495 :    
3496 :     #-------------------------------------------------------------------------------
3497 :     # subcellular location:
3498 :     #
3499 :     # ( [ $loc, $loc_ev, $top, $top_ev, $ori, $ori_ev, \@notes, $molecule ], ... ) = subcellular_loc( $entry )
3500 :     #
3501 :     # $loc = location description
3502 :     # $loc_ev = list of evidence items supporting this location
3503 :     # $top = topology of the protein
3504 :     # $top_ev = list of evidence items supporting this topology
3505 :     # $ori = orientation of the protein
3506 :     # $ori_ev = list of evidence items supporting this orientation
3507 :     # @notes = ( [ $note, $evidence, $status ], ... )
3508 :     # $molecule is sometimes an isoform, but is often a random factoid
3509 :     #
3510 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3511 :     #
3512 :     # entry.comment/subcellular location
3513 :     # attributes:
3514 :     # 339471 type
3515 :     # subelements:
3516 :     # 9076 molecule
3517 :     # 339439 subcellularLocation
3518 :     # 38531 text
3519 :     #
3520 :     # entry.comment/subcellular location.molecule
3521 :     # attributes:
3522 :     # 9076 _
3523 :     #
3524 :     # entry.comment/subcellular location.subcellularLocation
3525 :     # subelements:
3526 :     # 408515 location
3527 :     # 13196 orientation
3528 :     # 117350 topology
3529 :     #
3530 :     # entry.comment/subcellular location.subcellularLocation.location
3531 :     # attributes:
3532 :     # 408515 _
3533 :     # 352227 evidence
3534 :     # 1 status
3535 :     #
3536 :     # entry.comment/subcellular location.subcellularLocation.orientation
3537 :     # attributes:
3538 :     # 13196 _
3539 :     # 12125 evidence
3540 :     #
3541 :     # entry.comment/subcellular location.subcellularLocation.topology
3542 :     # attributes:
3543 :     # 117350 _
3544 :     # 103240 evidence
3545 :     #
3546 :     # entry.comment/subcellular location.text
3547 :     # attributes:
3548 :     # 38531 _
3549 :     # 28237 evidence
3550 :     #
3551 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3552 :    
3553 :     sub subcellular_loc
3554 :     {
3555 :     my @locs;
3556 :     foreach ( comments_of_type( $_[0], 'subcellular location' ) )
3557 :     {
3558 :     my $molecule = ( ( $_->{ molecule } || [] )->[0] || {} )->{_};
3559 :    
3560 :     my @notes = map { scalar evidenced_string( $_ ) }
3561 :     @{ $_->{ text } || [] };
3562 :    
3563 :     foreach ( @{ $_->{ subcellularLocation } } )
3564 :     {
3565 :     my $loc = $_->{ location }->[0]->{_};
3566 :     my $loc_ev = $_->{ location }->[0]->{ evidence };
3567 :     my $top = ( ( $_->{ topology } || [] )->[0] || {} )->{_};
3568 :     my $top_ev = ( ( $_->{ topology } || [] )->[0] || {} )->{ evidence };
3569 :     my $ori = ( ( $_->{ orientation } || [] )->[0] || {} )->{_};
3570 :     my $ori_ev = ( ( $_->{ orientation } || [] )->[0] || {} )->{ evidence };
3571 :    
3572 :     push @locs, [ $loc, $loc_ev, $top, $top_ev, $ori, $ori_ev, \@notes, $molecule ];
3573 :     }
3574 :     }
3575 :    
3576 :     wantarray ? @locs : \@locs;
3577 :     }
3578 :    
3579 :    
3580 :     #-------------------------------------------------------------------------------
3581 :     # subunit:
3582 :     #
3583 :     # ( $text_evid_stat, ... ) = subunit( $entry );
3584 :     # [ $text_evid_stat, ... ] = subunit( $entry );
3585 :     #
3586 :     # $text_evid_stat = [ $text, $evidence, $status ]
3587 :     #
3588 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3589 :     #
3590 :     # entry.comment/subunit
3591 :     # attributes:
3592 :     # 264027 type
3593 :     # subelements:
3594 :     # 264027 text
3595 :     #
3596 :     # entry.comment/subunit.text
3597 :     # attributes:
3598 :     # 264027 _
3599 :     # 249945 evidence
3600 :     # 20024 status
3601 :     #
3602 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3603 :    
3604 :     sub subunit
3605 :     {
3606 :     my @subunit;
3607 :     foreach ( comments_of_type( $_[0], 'subunit' ) )
3608 :     {
3609 :     push @subunit, map { scalar evidenced_string( $_ ) }
3610 :     @{ $_->{ text } || [] };
3611 :     }
3612 :    
3613 :     wantarray ? @subunit : \@subunit;
3614 :     }
3615 :    
3616 :    
3617 :     #-------------------------------------------------------------------------------
3618 :     # temp_dependence:
3619 :     #
3620 :     # ( $text_evid_stat, ... ) = subunit( $entry );
3621 :     # [ $text_evid_stat, ... ] = subunit( $entry );
3622 :     #
3623 :     # $text_evid_stat = [ $text, $evidence, $status ]
3624 :     #
3625 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3626 :     #
3627 :     # entry.comment/biophysicochemical properties
3628 :     # attributes:
3629 :     # 6929 type
3630 :     # subelements:
3631 :     # 138 absorption
3632 :     # 5250 kinetics
3633 :     # 3394 phDependence
3634 :     # 104 redoxPotential
3635 :     # 2002 temperatureDependence
3636 :     #
3637 :     # entry.comment/biophysicochemical properties.temperatureDependence
3638 :     # subelements:
3639 :     # 2002 text
3640 :     #
3641 :     # entry.comment/biophysicochemical properties.temperatureDependence.text
3642 :     # attributes:
3643 :     # 2002 _
3644 :     # 1645 evidence
3645 :     #
3646 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3647 :    
3648 :     sub temp_dependence
3649 :     {
3650 :     my @biophys;
3651 :     foreach ( comments_of_type( $_[0], 'biophysicochemical properties' ) )
3652 :     {
3653 :     if ( $_->{ temperatureDependence } )
3654 :     {
3655 :     foreach ( @{ $_->{ temperatureDependence } } )
3656 :     {
3657 :     push @biophys, map { scalar evidenced_string( $_ ) }
3658 :     @{ $_->{ text } || [] };
3659 :     }
3660 :     }
3661 :     }
3662 :    
3663 :     wantarray ? @biophys : \@biophys;
3664 :     }
3665 :    
3666 :    
3667 :     #-------------------------------------------------------------------------------
3668 :     # tissue specificity:
3669 :     #
3670 :     # ( $text_evid_stat, ... ) = tissue_specificity( $entry );
3671 :     # [ $text_evid_stat, ... ] = tissue_specificity( $entry );
3672 :     #
3673 :     # $text_evid_stat = [ $text, $evidence, $status ]
3674 :     #
3675 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3676 :     #
3677 :     # entry.comment/tissue specificity
3678 :     # attributes:
3679 :     # 42464 type
3680 :     # subelements:
3681 :     # 42464 text
3682 :     #
3683 :     # entry.comment/tissue specificity.text
3684 :     # attributes:
3685 :     # 42464 _
3686 :     # 27016 evidence
3687 :     #
3688 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3689 :    
3690 :     sub tissue_specificity
3691 :     {
3692 :     my @tissue;
3693 :     foreach ( comments_of_type( $_[0], 'tissue specificity' ) )
3694 :     {
3695 :     push @tissue, map { scalar evidenced_string( $_ ) }
3696 :     @{ $_->{ text } || [] };
3697 :     }
3698 :    
3699 :     wantarray ? @tissue : \@tissue;
3700 :     }
3701 :    
3702 :    
3703 :     #-------------------------------------------------------------------------------
3704 :     # toxic dose:
3705 :     #
3706 :     # ( $text_evid_stat, ... ) = toxic_dose( $entry );
3707 :     # [ $text_evid_stat, ... ] = toxic_dose( $entry );
3708 :     #
3709 :     # $text_evid_stat = [ $text, $evidence, $status ]
3710 :     #
3711 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3712 :     #
3713 :     # entry.comment/toxic dose
3714 :     # attributes:
3715 :     # 622 type
3716 :     # subelements:
3717 :     # 622 text
3718 :     #
3719 :     # entry.comment/toxic dose.text
3720 :     # attributes:
3721 :     # 622 _
3722 :     # 537 evidence
3723 :     #
3724 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3725 :    
3726 :     sub toxic_dose
3727 :     {
3728 :     my @dose;
3729 :     foreach ( comments_of_type( $_[0], 'toxic dose' ) )
3730 :     {
3731 :     push @dose, map { scalar evidenced_string( $_ ) }
3732 :     @{ $_->{ text } || [] };
3733 :     }
3734 :    
3735 :     wantarray ? @dose : \@dose;
3736 :     }
3737 :    
3738 :    
3739 :     #-------------------------------------------------------------------------------
3740 :     # evidenced string
3741 :     #
3742 :     # Many comment types include an "evidencedStringType". This is converted
3743 :     # to triples of [ $text, $evidence, $status ], where evidence is a string
3744 :     # on integer values that refer to the 'evidence' elements in the entry.
3745 :     # Status is a keword: "by similarity", "probable" or "potential".
3746 :     #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3747 :     # <xs:complexType name="evidencedStringType">
3748 :     # <xs:simpleContent>
3749 :     # <xs:extension base="xs:string">
3750 :     # <xs:attribute name="evidence" type="intListType" use="optional"/>
3751 :     # <xs:attribute name="status" use="optional">
3752 :     # <xs:simpleType>
3753 :     # <xs:restriction base="xs:string">
3754 :     # <xs:enumeration value="by similarity"/>
3755 :     # <xs:enumeration value="probable"/>
3756 :     # <xs:enumeration value="potential"/>
3757 :     # </xs:restriction>
3758 :     # </xs:simpleType>
3759 :     # </xs:attribute>
3760 :     # </xs:extension>
3761 :     # </xs:simpleContent>
3762 :     # </xs:complexType>
3763 :    
3764 :     sub evidenced_string
3765 :     {
3766 :     local $_ = $_[0] || {};
3767 :     wantarray ? ( $_->{_}, $_->{ evidence }, $_->{ status } )
3768 :     : [ $_->{_}, $_->{ evidence }, $_->{ status } ];
3769 :     }
3770 :    
3771 :    
3772 :     #-------------------------------------------------------------------------------
3773 :     # Cross reference data
3774 :     #
3775 :     # ( [ $db, $id, $properties, $mol_ids ], ... ) = xref( $entity );
3776 :     # [ [ $db, $id, $properties, $mol_ids ], ... ] = xref( $entity );
3777 :     #
3778 :     # Okay, most places in the XML, only the $db and $id fields are used, so:
3779 :     #
3780 :     # ( [ $db, $id ], ... ) = xref2( $entity );
3781 :     # [ [ $db, $id ], ... ] = xref2( $entity );
3782 :     #
3783 :     # $db is the external database
3784 :     # $id is the external id
3785 :     # $properties is a semicolon delimited list of "$info_type: $value" pairs
3786 :     # $mol_ids is a semicolon delimited list of alternative product ids
3787 :     #
3788 :     #-------------------------------------------------------------------------------
3789 :     #
3790 :     # entry.dbReference
3791 :     # attributes:
3792 :     # 198037 evidence
3793 :     # 18089205 id
3794 :     # 18089205 type
3795 :     # subelements:
3796 :     # 152168 molecule
3797 :     # 12115492 property
3798 :     #
3799 :     # entry.dbReference.molecule
3800 :     # attributes:
3801 :     # 152168 id
3802 :     #
3803 :     # entry.dbReference.property
3804 :     # attributes:
3805 :     # 22216598 type
3806 :     # 22216598 value
3807 :     #
3808 :    
3809 :     sub xref
3810 :     {
3811 :     my @xref = map { structure_xref( $_ ) }
3812 :     @{ xref_elements( @_ ) };
3813 :     wantarray ? @xref : \@xref;
3814 :     }
3815 :    
3816 :    
3817 :     sub xref2
3818 :     {
3819 :     my @xref = map { [ $_->{ type }, $_->{ id } ] }
3820 :     @{ xref_elements( @_ ) };
3821 :    
3822 :     wantarray ? @xref : \@xref;
3823 :     }
3824 :    
3825 :    
3826 :     sub structure_xref
3827 :     {
3828 :     local $_ = shift or return ();
3829 :     my $type = $_->{ type };
3830 :     my $id = $_->{ id };
3831 :    
3832 :     my @properties = map { "$_->{type}: $_->{value}" }
3833 :     @{ $_->{ property } || [] };
3834 :    
3835 :     my @mol_ids = map { $_->{ id } }
3836 :     @{ $_->{ molecule } || [] };
3837 :    
3838 :     [ $type, $id, join( '; ', @properties ), join( '; ', @mol_ids ) ];
3839 :     }
3840 :    
3841 :    
3842 :     #-------------------------------------------------------------------------------
3843 :     # Protein existence data:
3844 :     #
3845 :     # $keyword = existence_ev( $entry )
3846 :     #
3847 :     # $keyword is one of: evidence at protein level | evidence at transcript level
3848 :     # | inferred from homology | predicted | uncertain
3849 :     #
3850 :     #-------------------------------------------------------------------------------
3851 :     #
3852 :     # entry.proteinExistence
3853 :     # attributes:
3854 :     # 550740 type
3855 :     #
3856 :    
3857 :     sub existence_ev
3858 :     {
3859 :     prot_exist_element( @_ )->{ type };
3860 :     }
3861 :    
3862 :    
3863 :     #-------------------------------------------------------------------------------
3864 :     # Keyword data:
3865 :     #
3866 :     # @keywords = keywords( $entry )
3867 :     # $keywords = keywords( $entry )
3868 :     #
3869 :     # ( [ $id, $keyword ], ... ) = id_keywords( $entry )
3870 :     # $id_keywords = id_keywords( $entry )
3871 :     #
3872 :     # The scalar forms give a semicolon delimited list.
3873 :     #
3874 :     #-------------------------------------------------------------------------------
3875 :     #
3876 :     # entry.keyword
3877 :     # attributes:
3878 :     # 3934560 _
3879 :     # 3934560 id
3880 :     #
3881 :    
3882 :     sub keywords
3883 :     {
3884 :     my @keywords = map { $_->{_} } @{ keyword_elements( @_ ) };
3885 :     wantarray ? @keywords : join '; ', @keywords;
3886 :     }
3887 :    
3888 :    
3889 :     sub id_keywords
3890 :     {
3891 :     my @keywords = map { [ $_->{id}, $_->{_} ] } @{ keyword_elements( @_ ) };
3892 :     wantarray ? @keywords : join '; ', map { "$_->[0]: $_->[1]" } @keywords;
3893 :     }
3894 :    
3895 :    
3896 :     #-------------------------------------------------------------------------------
3897 :     # Feature data
3898 :     #
3899 :     # ( [ $type, $loc, $description, $id, $status, $evidence, $ref ], ... ) = features( $entry );
3900 :     # [ [ $type, $loc, $description, $id, $status, $evidence, $ref ], ... ] = features( $entry );
3901 :     #
3902 :     # $type = feature type
3903 :     # $loc = [ $begin, $end, $sequence ]
3904 :     # $sequence = literal sequence, when an amino acid range does not apply
3905 :     # $description = text description of the feature
3906 :     # $id = a feature id
3907 :     # $status = keyword: by similarity | probable | potential
3908 :     # $evidence = space separated list of evidence items that apply
3909 :     # $ref = space separated list of reference numbers that apply
3910 :     #
3911 :     #-------------------------------------------------------------------------------
3912 :     #
3913 :     # entry.feature
3914 :     # attributes:
3915 :     # 3402079 description
3916 :     # 3247281 evidence
3917 :     # 708327 id
3918 :     # 131880 ref
3919 :     # 50 status
3920 :     # 4142822 type
3921 :     # subelements:
3922 :     # 4142822 location
3923 :     # 296939 original
3924 :     # 296939 variation
3925 :     #
3926 :     # entry.feature.location
3927 :     # subelements:
3928 :     # 2586609 begin
3929 :     # 2586609 end
3930 :     # 1556213 position
3931 :     #
3932 :     # entry.feature.location.begin
3933 :     # attributes:
3934 :     # 2584123 position
3935 :     # 9274 status
3936 :     #
3937 :     # entry.feature.location.end
3938 :     # attributes:
3939 :     # 2583720 position
3940 :     # 10508 status
3941 :     #
3942 :     # entry.feature.location.position
3943 :     # attributes:
3944 :     # 1556213 position
3945 :     #
3946 :     # entry.feature.original
3947 :     # attributes:
3948 :     # 296939 _
3949 :     #
3950 :     # entry.feature.variation
3951 :     # attributes:
3952 :     # 301249 _
3953 :     #
3954 :     # <!-- Feature definition begins -->
3955 :     # <xs:complexType name="featureType">
3956 :     # <xs:attribute name="type" use="required">
3957 :     # <xs:simpleType>
3958 :     # <xs:restriction base="xs:string">
3959 :     # <xs:enumeration value="active site"/>
3960 :     # <xs:enumeration value="binding site"/>
3961 :     # <xs:enumeration value="calcium-binding region"/>
3962 :     # <xs:enumeration value="chain"/>
3963 :     # <xs:enumeration value="coiled-coil region"/>
3964 :     # <xs:enumeration value="compositionally biased region"/>
3965 :     # <xs:enumeration value="cross-link"/>
3966 :     # <xs:enumeration value="disulfide bond"/>
3967 :     # <xs:enumeration value="DNA-binding region"/>
3968 :     # <xs:enumeration value="domain"/>
3969 :     # <xs:enumeration value="glycosylation site"/>
3970 :     # <xs:enumeration value="helix"/>
3971 :     # <xs:enumeration value="initiator methionine"/>
3972 :     # <xs:enumeration value="lipid moiety-binding region"/>
3973 :     # <xs:enumeration value="metal ion-binding site"/>
3974 :     # <xs:enumeration value="modified residue"/>
3975 :     # <xs:enumeration value="mutagenesis site"/>
3976 :     # <xs:enumeration value="non-consecutive residues"/>
3977 :     # <xs:enumeration value="non-terminal residue"/>
3978 :     # <xs:enumeration value="nucleotide phosphate-binding region"/>
3979 :     # <xs:enumeration value="peptide"/>
3980 :     # <xs:enumeration value="propeptide"/>
3981 :     # <xs:enumeration value="region of interest"/>
3982 :     # <xs:enumeration value="repeat"/>
3983 :     # <xs:enumeration value="non-standard amino acid"/>
3984 :     # <xs:enumeration value="sequence conflict"/>
3985 :     # <xs:enumeration value="sequence variant"/>
3986 :     # <xs:enumeration value="short sequence motif"/>
3987 :     # <xs:enumeration value="signal peptide"/>
3988 :     # <xs:enumeration value="site"/>
3989 :     # <xs:enumeration value="splice variant"/>
3990 :     # <xs:enumeration value="strand"/>
3991 :     # <xs:enumeration value="topological domain"/>
3992 :     # <xs:enumeration value="transit peptide"/>
3993 :     # <xs:enumeration value="transmembrane region"/>
3994 :     # <xs:enumeration value="turn"/>
3995 :     # <xs:enumeration value="unsure residue"/>
3996 :     # <xs:enumeration value="zinc finger region"/>
3997 :     # <xs:enumeration value="intramembrane region"/>
3998 :     # </xs:restriction>
3999 :     # </xs:simpleType>
4000 :     # </xs:attribute>
4001 :     #
4002 :     # <xs:attribute name="status" use="optional">
4003 :     # <xs:simpleType>
4004 :     # <xs:restriction base="xs:string">
4005 :     # <xs:enumeration value="by similarity"/>
4006 :     # <xs:enumeration value="probable"/>
4007 :     # <xs:enumeration value="potential"/>
4008 :     # </xs:restriction>
4009 :     # </xs:simpleType>
4010 :     # </xs:attribute>
4011 :     #
4012 :     # <xs:attribute name="id" type="xs:string" use="optional"/>
4013 :     # <xs:attribute name="description" type="xs:string" use="optional"/>
4014 :     # <xs:attribute name="evidence" type="intListType" use="optional"/>
4015 :     # <xs:attribute name="ref" type="xs:string" use="optional"/>
4016 :     #
4017 :     # <xs:sequence>
4018 :     #
4019 :     # <!-- Describes the original sequence in annotations that describe natural or artifical sequence variations. -->
4020 :     # <xs:element name="original" type="xs:string" minOccurs="0"/>
4021 :     #
4022 :     # <!-- Describes the variant sequence in annotations that describe natural or artifical sequence variations. -->
4023 :     # <xs:element name="variation" type="xs:string" minOccurs="0" maxOccurs="unbounded"/>
4024 :     #
4025 :     # <!-- Describes the sequence coordinates of the annotation. -->
4026 :     # <xs:element name="location" type="locationType"/>
4027 :     #
4028 :     # </xs:sequence>
4029 :     #
4030 :     # </xs:complexType>
4031 :     #
4032 :     # <xs:complexType name="locationType">
4033 :     # <xs:attribute name="sequence" type="xs:string" use="optional"/>
4034 :     # <xs:choice>
4035 :     # <xs:sequence>
4036 :     # <xs:element name="begin" type="positionType"/>
4037 :     # <xs:element name="end" type="positionType"/>
4038 :     # </xs:sequence>
4039 :     # <xs:element name="position" type="positionType"/>
4040 :     # </xs:choice>
4041 :     # </xs:complexType>
4042 :     #
4043 :     # <xs:complexType name="positionType">
4044 :     # <xs:attribute name="position" type="xs:unsignedLong" use="optional"/>
4045 :     # <xs:attribute name="status" use="optional" default="certain">
4046 :     # <xs:simpleType>
4047 :     # <xs:restriction base="xs:string">
4048 :     # <xs:enumeration value="certain"/>
4049 :     # <xs:enumeration value="uncertain"/>
4050 :     # <xs:enumeration value="less than"/>
4051 :     # <xs:enumeration value="greater than"/>
4052 :     # <xs:enumeration value="unknown"/>
4053 :     # </xs:restriction>
4054 :     # </xs:simpleType>
4055 :     # </xs:attribute>
4056 :     # <xs:attribute name="evidence" type="intListType" use="optional"/>
4057 :     # </xs:complexType>
4058 :     #
4059 :     # <!-- Feature definition ends -->
4060 :    
4061 :     sub features
4062 :     {
4063 :     my @feat;
4064 :     foreach my $feat ( @{ feature_elements( @_ ) } )
4065 :     {
4066 :     my $type = $feat->{ type };
4067 :     my $status = $feat->{ status };
4068 :     my $id = $feat->{ id };
4069 :     my $description = $feat->{ description };
4070 :     my $evidence = $feat->{ evidence };
4071 :     my $ref = $feat->{ ref };
4072 :     my $loc = ftr_location( $feat->{ location }->[0] );
4073 :    
4074 :     push @feat, [ $type, $loc, $description, $id, $status, $evidence, $ref ];
4075 :     }
4076 :    
4077 :     wantarray ? @feat : \@feat;
4078 :     }
4079 :    
4080 :    
4081 :     sub ftr_location
4082 :     {
4083 :     my $loc_element = shift;
4084 :     my $beg = ( $loc_element->{ begin } || $loc_element->{ position } || [{}] )->[0]->{ position };
4085 :     my $end = ( $loc_element->{ end } || $loc_element->{ position } || [{}] )->[0]->{ position };
4086 :     my $seq = $loc_element->{ sequence };
4087 :    
4088 :     [ $beg, $end, $seq ];
4089 :     }
4090 :    
4091 :    
4092 :     #-------------------------------------------------------------------------------
4093 :     # Evidence associated data
4094 :     #
4095 :     # ( [ $key, $type, \@ref, \@xref ], ... ) = evidence( $entry )
4096 :     #
4097 :     # $key is the index used in evidenced strings, and other similar entries.
4098 :     # $type is an EOO evidence code
4099 :     # \@ref is a list of reference numbers in the entry reference list
4100 :     # \@xref is a list of database cross references
4101 :     #
4102 :     # Observation: many of the $ref entry numbers are out of range, suggesting
4103 :     # that there might be a merged reference list somewhere.
4104 :     #-------------------------------------------------------------------------------
4105 :     #
4106 :     # entry.evidence
4107 :     # attributes:
4108 :     # 1373290 key
4109 :     # 1373290 type
4110 :     # subelements:
4111 :     # 1373290 source
4112 :     #
4113 :     # entry.evidence.source
4114 :     # attributes:
4115 :     # 47208 ref
4116 :     # subelements:
4117 :     # 841512 dbReference
4118 :     #
4119 :     # entry.evidence.source.dbReference
4120 :     # attributes:
4121 :     # 841512 id
4122 :     # 841512 type
4123 :     #
4124 :    
4125 :     sub evidence
4126 :     {
4127 :     my @evidence;
4128 :     foreach my $ev ( @{ evidence_elements( @_ ) } )
4129 :     {
4130 :     my $key = $ev->{ key };
4131 :     my $type = $ev->{ type };
4132 :     my @refs = grep { $_ } map { $_->{ ref } } @{ $ev->{ source } || [] };
4133 :     my @xref = map { xref( $_ ) } @{ $ev->{ source } || [] };
4134 :     # my @import = map { xref( $_ ) } @{ $ev->{ importedFrom } || [] };
4135 :     push @evidence, [ $key, $type, \@refs, \@xref ];
4136 :     }
4137 :    
4138 :     wantarray ? @evidence : \@evidence;
4139 :     }
4140 :    
4141 :    
4142 :     #-------------------------------------------------------------------------------
4143 :     # Sequence associated data
4144 :     #
4145 :     # $sequence = sequence( $entry );
4146 :     # $length = length( $entry );
4147 :     # $md5 = md5( $entry ); # base 64 md5 of uc sequence
4148 :     # $mass = mass( $entry );
4149 :     # $checksum = checksum( $entry );
4150 :     # $seqmoddate = seqmoddate( $entry ); # date of last sequence change
4151 :     # $seqversion = seqversion( $entry ); # version of sequence (not entry)
4152 :     # $fragment = fragment( $entry ); # single | multiple
4153 :     # $precursor = precursor( $entry ); # boolean
4154 :     #
4155 :     #-------------------------------------------------------------------------------
4156 :     #
4157 :     # entry.sequence
4158 :     # attributes:
4159 :     # 550740 _
4160 :     # 550740 checksum
4161 :     # 9151 fragment
4162 :     # 550740 length
4163 :     # 550740 mass
4164 :     # 550740 md5
4165 :     # 550740 modified
4166 :     # 53324 precursor
4167 :     # 550740 version
4168 :     #
4169 :    
4170 :     sub sequence { sequence_element( @_ )->{_} }
4171 :     sub length { sequence_element( @_ )->{ length } }
4172 :     sub md5 { sequence_element( @_ )->{ md5 } } # Our addition
4173 :     sub mass { sequence_element( @_ )->{ mass } }
4174 :    
4175 :     sub checksum { sequence_element( @_ )->{ checksum } }
4176 :     sub seqmoddate { sequence_element( @_ )->{ modified } }
4177 :     sub seqversion { sequence_element( @_ )->{ version } }
4178 :    
4179 :     sub fragment { sequence_element( @_ )->{ fragment } } # single | multiple
4180 :     sub precursor { ( sequence_element( @_ )->{ precursor } || '' ) eq 'true' }
4181 :    
4182 :    
4183 :     #-------------------------------------------------------------------------------
4184 :     # Get an input file handle, and boolean on whether to close or not:
4185 :     #
4186 :     # ( $fh, $close ) = input_file_handle( $filename );
4187 :     # ( $fh, $close ) = input_file_handle( \*FH );
4188 :     # ( $fh, $close ) = input_file_handle( \$string );
4189 :     # ( $fh, $close ) = input_file_handle( '' ); # STDIN
4190 :     # ( $fh, $close ) = input_file_handle( ); # STDIN
4191 :     #
4192 :     # $fh is assigned an open file handle (upon success)
4193 :     # $close is a flag indicating the the file was openend by input_file_handle(),
4194 :     # and should be closed by the user after it is written.
4195 :     #-------------------------------------------------------------------------------
4196 :    
4197 :     sub input_file_handle
4198 :     {
4199 :     my ( $file ) = @_;
4200 :    
4201 :     my ( $fh, $close );
4202 :    
4203 :     # STDIN
4204 :     if ( ! defined $file || $file eq '' )
4205 :     {
4206 :     $fh = \*STDIN;
4207 :     $close = 0;
4208 :     }
4209 :    
4210 :     # An open file handle
4211 :     elsif ( ref $file eq 'GLOB' )
4212 :     {
4213 :     $fh = $file;
4214 :     $close = 0;
4215 :     }
4216 :    
4217 :     # A reference to a scalar (string)
4218 :     elsif ( ref $file eq 'SCALAR' )
4219 :     {
4220 :     open( $fh, "<", $file ) || die "input_file_handle could not open scalar reference.\n";
4221 :     $close = 1;
4222 :     }
4223 :    
4224 :     # A file
4225 :     elsif ( ! ref $file && -f $file )
4226 :     {
4227 :     open( $fh, "<", $file ) || die "input_file_handle could not open '$file'.\n";
4228 :     $close = 1;
4229 :     }
4230 :    
4231 :     else
4232 :     {
4233 :     die "input_file_handle could not open file '$file'.\n";
4234 :     }
4235 :    
4236 :     wantarray ? ( $fh, $close ) : $fh;
4237 :     }
4238 :    
4239 :    
4240 :     #-------------------------------------------------------------------------------
4241 :     # Get an output file handle, and boolean on whether to close or not:
4242 :     #
4243 :     # ( $fh, $close ) = output_file_handle( $filename );
4244 :     # ( $fh, $close ) = output_file_handle( \*FH );
4245 :     # ( $fh, $close ) = output_file_handle( ); # D = STDOUT
4246 :     #
4247 :     #-------------------------------------------------------------------------------
4248 :    
4249 :     sub output_file_handle
4250 :     {
4251 :     my ( $file, $umask ) = @_;
4252 :    
4253 :     my ( $fh, $close );
4254 :    
4255 :     if ( ! defined $file || $file eq '' )
4256 :     {
4257 :     $fh = \*STDOUT;
4258 :     $close = 0;
4259 :     }
4260 :     elsif ( ref $file eq 'GLOB' )
4261 :     {
4262 :     $fh = $file;
4263 :     $close = 0;
4264 :     }
4265 :     elsif ( ref $file eq 'SCALAR' )
4266 :     {
4267 :     open( $fh, ">", $file ) || die "output_file_handle could not open scalar reference.\n";
4268 :     $close = 1;
4269 :     }
4270 :     else
4271 :     {
4272 :     open( $fh, ">", $file ) || die "output_file_handle could not open '$file'.\n";
4273 :     chmod 0664, $file; # Seems to work on open file!
4274 :     $close = 1;
4275 :     }
4276 :    
4277 :     wantarray ? ( $fh, $close ) : $fh;
4278 :     }
4279 :    
4280 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3