File Coverage

Bio/Structure/Entry.pm
Criterion Covered Total %
statement 241 339 71.0
branch 89 160 55.6
condition 24 54 44.4
subroutine 31 37 83.7
pod 22 22 100.0
total 407 612 66.5


line stmt bran cond sub pod time code
1             #
2             # bioperl module for Bio::Structure::Entry
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Kris Boulez
7             #
8             # Copyright Kris Boulez
9             #
10             # You may distribute this module under the same terms as perl itself
11              
12             # POD documentation - main docs before the code
13              
14             =head1 NAME
15              
16             Bio::Structure::Entry - Bioperl structure Object, describes the whole entry
17              
18             =head1 SYNOPSIS
19              
20             #add synopsis here
21              
22             =head1 DESCRIPTION
23              
24             This object stores a whole Bio::Structure entry. It can consist of one
25             or more models (L), which in turn consist of one
26             or more chains (L). A chain is composed of residues
27             (L) and a residue consists of atoms
28             (L). If no specific model or chain is chosen, the
29             first one is chosen.
30              
31             =head1 FEEDBACK
32              
33             =head2 Mailing Lists
34              
35             User feedback is an integral part of the evolution of this and other
36             Bioperl modules. Send your comments and suggestions preferably to one
37             of the Bioperl mailing lists. Your participation is much appreciated.
38              
39             bioperl-l@bioperl.org - General discussion
40             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
41              
42             =head2 Support
43              
44             Please direct usage questions or support issues to the mailing list:
45              
46             I
47              
48             rather than to the module maintainer directly. Many experienced and
49             reponsive experts will be able look at the problem and quickly
50             address it. Please include a thorough description of the problem
51             with code and data examples if at all possible.
52              
53             =head2 Reporting Bugs
54              
55             Report bugs to the Bioperl bug tracking system to help us keep track
56             the bugs and their resolution. Bug reports can be submitted via the web:
57              
58             https://github.com/bioperl/bioperl-live/issues
59              
60             =head1 AUTHOR - Kris Boulez
61              
62             Email kris.boulez@algonomics.com
63              
64             =head1 APPENDIX
65              
66             The rest of the documentation details each of the object methods. Internal
67             methods are usually preceded with a _
68              
69             =cut
70              
71              
72             # Let the code begin...
73              
74             package Bio::Structure::Entry;
75 2     2   490 use strict;
  2         2  
  2         45  
76              
77 2     2   497 use Bio::Structure::Model;
  2         2  
  2         36  
78 2     2   8 use Bio::Structure::Chain;
  2         49  
  2         27  
79 2     2   575 use Bio::Annotation::Collection;
  2         4  
  2         38  
80 2     2   796 use Tie::RefHash;
  2         4235  
  2         43  
81              
82 2     2   8 use base qw(Bio::Root::Root Bio::Structure::StructureI);
  2         2  
  2         576  
83              
84             =head2 new()
85              
86             Title : new()
87             Usage : $struc = Bio::Structure::Entry->new(
88             -id => 'structure_id',
89             );
90              
91             Function: Returns a new Bio::Structure::Entry object from basic
92             constructors. Probably most called from Bio::Structure::IO.
93             Returns : a new Bio::Structure::Model object
94              
95             =cut
96              
97             sub new {
98 4     4 1 1711 my ($class, @args) = @_;
99 4         19 my $self = $class->SUPER::new(@args);
100              
101 4         21 my($id, $model, $chain, $residue ) =
102             $self->_rearrange([qw(
103             ID
104             MODEL
105             CHAIN
106             RESIDUE )], @args);
107              
108             # where to store parent->child relations (1 -> 1..n)
109             # value to this hash will be an array ref
110             # by using Tie::RefHash we can store references in this hash
111 4         15 $self->{'p_c'} = ();
112 4         4 tie %{ $self->{'p_c'} } , "Tie::RefHash";
  4         28  
113            
114             # where to store child->parent relations (1 -> 1)
115 4         34 $self->{'c_p'} = ();
116 4         4 tie %{ $self->{'c_p'} } , "Tie::RefHash";
  4         11  
117              
118 4 100       28 $id && $self->id($id);
119              
120 4         7 $self->{'model'} = [];
121 4 50       9 $model && $self->model($model);
122              
123 4 50       7 if($chain) {
124 0 0       0 if ( ! defined($self->model) ) { # no model yet, create default one
125 0         0 $self->_create_default_model;
126             }
127 0         0 for my $m ($self->model) { # add this chain on all models
128 0         0 $m->chain($chain);
129             }
130             }
131              
132 4 50       12 $residue && $self->residue($residue);
133              
134             # taken from Bio::Seq (or should we just inherit Bio::Seq and override some methods)
135 4         24 my $ann = Bio::Annotation::Collection->new;
136 4         9 $self->annotation($ann);
137              
138 4         12 return $self;
139             }
140              
141              
142             =head2 model()
143              
144             Title : model
145             Function: Connects a (or a list of) Model objects to a Bio::Structure::Entry.
146             To add a Model (and keep the existing ones) use add_model()
147             It returns a list of Model objects.
148             Returns : List of Bio::Structure::Model objects
149             Args : One Model or a reference to an array of Model objects
150              
151             =cut
152              
153             sub model {
154 15     15 1 19 my ($self, $model) = @_;
155            
156 15 100       27 if( defined $model) {
157 4 50 66     24 if( (ref($model) eq "ARRAY") ||
158             ($model->isa('Bio::Structure::Model')) ) {
159             # remove existing ones, tell they've become orphan
160 4         7 my @obj = $self->model;
161 4 100       7 if (@obj) {
162 3         3 for my $m (@obj) {
163 5         8 $self->_remove_from_graph($m);
164 5         38 $self->{'model'} = [];
165             }
166             }
167             # add the new ones
168 4         10 $self->add_model($self,$model);
169             }
170             else {
171 0         0 $self->throw("Supplied a $model to model, we want a Bio::Structure::Model or a list of these\n");
172             }
173             }
174             # give back list of models via general get method
175 15         20 $self->get_models($self);
176             }
177              
178              
179              
180             =head2 add_model()
181              
182             Title : add_model
183             Usage : $structure->add_model($model);
184             Function: Adds a (or a list of) Model objects to a Bio::Structure::Entry.
185             Returns :
186             Args : One Model or a reference to an array of Model objects
187              
188             =cut
189              
190             sub add_model {
191 29     29 1 28 my($self,$entry,$model) = @_;
192              
193             # if only one argument and it's a model, change evrything one place
194             # this is for people calling $entry->add_model($model);
195 29 100 100     103 if ( !defined $model && ref($entry) =~ /^Bio::Structure::Model/) {
196 1         2 $model = $entry;
197 1         1 $entry = $self;
198             }
199             # $self and $entry are the same here, but it's used for uniformicity
200 29 50 33     94 if ( !defined($entry) || ref($entry) !~ /^Bio::Structure::Entry/) {
201 0         0 $self->throw("first argument to add_model needs to be a Bio::Structure::Entry object\n");
202             }
203 29 100       47 if (defined $model) {
204 7 100       35 if (ref($model) eq "ARRAY") {
    50          
205             # if the user passed in a reference to an array
206 1         2 for my $m ( @{$model} ) {
  1         2  
207 2 50       5 if( ! $m->isa('Bio::Structure::Model') ) {
208 0         0 $self->throw("$m is not a Model\n");
209             }
210 2 50       3 if ( $self->_parent($m) ) {
211 0         0 $self->throw("$m already assigned to a parent\n");
212             }
213 2         11 push @{$self->{'model'}}, $m;
  2         5  
214             # create a stringified version of our ref
215             # not used untill we get symbolic ref working
216             #my $str_ref = "$self";
217             #$m->_grandparent($str_ref);
218             }
219             }
220             elsif ( $model->isa('Bio::Structure::Model') ) {
221 6 50       10 if ( $self->_parent($model) ) { # already assigned to a parent
222 0         0 $self->throw("$model already assigned\n");
223             }
224 6         50 push @{$self->{'model'}}, $model;
  6         13  
225             # create a stringified version of our ref
226             #my $str_ref = "$self";
227             #$model->_grandparent($str_ref);
228             }
229             else {
230 0         0 $self->throw("Supplied a $model to add_model, we want a Model or list of Models\n");
231             }
232             }
233              
234 29         27 my $array_ref = $self->{'model'};
235 29 50       71 return $array_ref ? @{$array_ref} : ();
  29         65  
236             }
237              
238              
239             =head2 get_models()
240              
241             Title : get_models
242             Usage : $structure->get_models($structure);
243             Function: general get method for models attached to an Entry
244             Returns : a list of models attached to this entry
245             Args : an Entry
246              
247             =cut
248              
249             sub get_models {
250 22     22 1 21 my ($self, $entry) = @_;
251              
252             # self and entry can be the same
253 22 100       35 if ( !defined $entry) {
254 5         8 $entry = $self;
255             }
256             # pass through to add_model
257 22         28 $self->add_model($entry);
258             }
259              
260              
261             =head2 id()
262              
263             Title : id
264             Usage : $entry->id("identity");
265             Function: Gets/sets the ID
266             Returns : The ID
267             Args :
268              
269             =cut
270              
271             sub id {
272 7     7 1 9 my ($self, $value) = @_;
273 7 100       22 if (defined $value) {
274 5         6 $self->{'id'} = $value;
275             }
276 7         12 return $self->{'id'};
277             }
278              
279              
280             =head2 chain()
281              
282             Title : chain
283             Usage : @chains = $structure->chain($chain);
284             Function: Connects a Chain or a list of Chain objects to a Bio::Structure::Entry.
285             Returns : List of Bio::Structure::Chain objects
286             Args : A Chain or a reference to an array of Chain objects
287              
288             =cut
289              
290             sub chain {
291 1     1 1 2 my ($self, $chain) = @_;
292              
293 1 50       5 if ( ! $self->model ) {
294 0         0 $self->_create_default_model;
295             }
296 1         4 my @models = $self->model;
297 1         2 my $first_model = $models[0];
298              
299 1 50       4 if ( defined $chain) {
300            
301 0 0 0     0 if( (ref($chain) eq "ARRAY") || ($chain->isa('Bio::Structure::Chain')) ) {
302             # remove existing ones, tell they've become orphan
303 0         0 my @obj = $self->get_chains($first_model);
304 0 0       0 if (@obj) {
305 0         0 for my $c (@obj) {
306 0         0 $self->_remove_from_graph($c);
307             }
308             }
309             # add the new ones
310 0         0 $self->add_chain($first_model,$chain);
311             }
312             else {
313 0         0 $self->throw("Supplied a $chain to chain, we want a Bio::Structure::Chain or a list of these\n");
314             }
315             }
316 1         3 $self->get_chains($first_model);
317             }
318              
319              
320             =head2 add_chain()
321              
322             Title : add_chain
323             Usage : @chains = $structure->add_chain($model,$chain);
324             Function: Adds one or more Chain objects to a Bio::Structure::Entry.
325             Returns : List of Chain objects associated with the Model
326             Args : A Model object and a Chain object or a reference to an array of
327             of Chain objects
328              
329             =cut
330              
331             sub add_chain {
332 16     16 1 22 my($self, $model, $chain) = @_;
333              
334 16 50       43 if (ref($model) !~ /^Bio::Structure::Model/) {
335 0         0 $self->throw("add_chain: first argument needs to be a Model object ($model)\n");
336             }
337 16 100       26 if (defined $chain) {
338 7 50       34 if (ref($chain) eq "ARRAY") {
    50          
339             # if the user passed in a reference to an array
340 0         0 for my $c ( @{$chain} ) {
  0         0  
341 0 0       0 if( ! $c->isa('Bio::Structure::Chain') ) {
342 0         0 $self->throw("$c is not a Chain\n");
343             }
344 0 0       0 if ( $self->_parent($c) ) {
345 0         0 $self->throw("$c already assigned to a parent\n");
346             }
347 0         0 $self->_parent($c, $model);
348 0         0 $self->_child($model, $c);
349             # stringify $self ref
350             #my $str_ref = "$self";
351             #$c->_grandparent($str_ref);
352             }
353             }
354             elsif ( $chain->isa('Bio::Structure::Chain') ) {
355 7 50       13 if ( $self->_parent($chain) ) { # already assigned to parent
356 0         0 $self->throw("$chain already assigned to a parent\n");
357             }
358 7         65 $self->_parent($chain,$model);
359 7         38 $self->_child($model, $chain);
360             # stringify $self ref
361             #my $str_ref = "$self";
362             #$chain->_grandparent($str_ref);
363             }
364             else {
365 0         0 $self->throw("Supplied a $chain to add_chain, we want a Chain or list of Chains\n");
366             }
367             }
368 16         48 my $array_ref = $self->_child($model);
369 16 50       100 return $array_ref ? @{$array_ref} : ();
  16         30  
370             }
371              
372              
373             =head2 get_chains()
374              
375             Title : get_chains
376             Usage : $entry->get_chains($model);
377             Function: General get method for Chains attached to a Model
378             Returns : A list of Chains attached to this model
379             Args : A Model
380              
381             =cut
382              
383             sub get_chains {
384 9     9 1 15 my ($self, $model) = @_;
385              
386 9 100       18 if (! defined $model) {
387 1         5 $model = ($self->get_models)[0];
388             }
389             # pass through to add_chain
390 9         14 $self->add_chain($model);
391             }
392              
393              
394             =head2 residue()
395              
396             Title : residue
397             Usage : @residues = $structure->residue($residue);
398             Function: Connects a (or a list of) Residue objects to a Bio::Structure::Entry.
399             Returns : List of Bio::Structure::Residue objects
400             Args : One Residue or a reference to an array of Residue objects
401              
402             =cut
403              
404             sub residue {
405 1     1 1 4 my ($self, $residue) = @_;
406              
407 1 50       2 if ( ! $self->model ) {
408 0         0 my $m = $self->_create_default_model;
409 0         0 $self->add_model($self,$m);
410             }
411 1         4 my @models = $self->model;
412 1         2 my $first_model = $models[0];
413            
414 1 50       2 if ( ! $self->get_chains($first_model) ) {
415 0         0 my $c = $self->_create_default_chain;
416 0         0 $self->add_chain($first_model, $c);
417             }
418 1         3 my @chains = $self->get_chains($first_model);
419 1         2 my $first_chain = $chains[0];
420              
421 1 50       3 if( defined $residue) {
422 0 0 0     0 if( (ref($residue) eq "ARRAY") ||
423             ($residue->isa('Bio::Structure::Residue')) ) {
424             # remove existing ones, tell they've become orphan
425 0         0 my @obj = $self->get_residues($first_chain);
426 0 0       0 if (@obj) {
427 0         0 for my $r (@obj) {
428 0         0 $self->_remove_from_graph($r);
429             }
430             }
431             # add the new ones
432 0         0 $self->add_residue($first_chain,$residue);
433             }
434             else {
435 0         0 $self->throw("Supplied a $residue to residue, we want a Bio::Structure::Residue or a list of these\n");
436             }
437             }
438 1         4 $self->get_residues($first_chain);
439             }
440              
441              
442             =head2 add_residue()
443              
444             Title : add_residue
445             Usage : @residues = $structure->add_residue($chain,$residue);
446             Function: Adds one or more Residue objects to a Bio::Structure::Entry.
447             Returns : List of Bio::Structure::Residue objects
448             Args : A Chain object and a Residue object or a reference to an array of
449             Residue objects
450              
451             =cut
452              
453             sub add_residue {
454 172     172 1 151 my($self,$chain,$residue) = @_;
455              
456 172 50       404 if (ref($chain) !~ /^Bio::Structure::Chain/) {
457 0         0 $self->throw("add_residue: first argument needs to be a Chain object\n");
458             }
459 172 100       201 if (defined $residue) {
460 160 50       468 if (ref($residue) eq "ARRAY") {
    50          
461             # if the user passed in a reference to an array
462 0         0 for my $r ( @{$residue} ) {
  0         0  
463 0 0       0 if( ! $r->isa('Bio::Structure::Residue') ) {
464 0         0 $self->throw("$r is not a Residue\n");
465             }
466 0 0       0 if ( $self->_parent($r) ) {
467 0         0 $self->throw("$r already belongs to a parent\n");
468             }
469 0         0 $self->_parent($r, $chain);
470 0         0 $self->_child($chain, $r);
471             # stringify
472 0         0 my $str_ref = "$self";
473 0         0 $r->_grandparent($str_ref);
474             }
475             }
476             elsif ( $residue->isa('Bio::Structure::Residue') ) {
477 160 50       190 if ( $self->_parent($residue) ) {
478 0         0 $self->throw("$residue already belongs to a parent\n");
479             }
480 160         1053 $self->_parent($residue, $chain);
481 160         738 $self->_child($chain, $residue);
482             # stringify
483 160         738 my $str_ref = "$self";
484 160         244 $residue->_grandparent($str_ref);
485             }
486             else {
487 0         0 $self->throw("Supplied a $residue to add_residue, we want a Residue or list of Residues\n");
488             }
489             }
490 172         177 my $array_ref = $self->_child($chain);
491 172 50       892 return $array_ref ? @{$array_ref} : ();
  172         252  
492             }
493              
494              
495             =head2 get_residues()
496              
497             Title : get_residues
498             Usage : $structure->get_residues($chain);
499             Function: General get method for Residues attached to a Chain
500             Returns : A list of residues attached to this Chain
501             Args : A Chain
502              
503             =cut
504              
505             sub get_residues {
506 12     12 1 34 my ($self, $chain) = @_;
507              
508 12 50       17 if ( !defined $chain) {
509 0         0 $self->throw("get_residues needs a Chain as argument");
510             }
511             # pass through to add_residue
512 12         22 $self->add_residue($chain);
513             }
514              
515              
516             =head2 add_atom()
517              
518             Title : add_atom
519             Usage : @atoms = $structure->add_atom($residue,$atom);
520             Function: Adds a (or a list of) Atom objects to a Bio::Structure::Residue.
521             Returns : List of Bio::Structure::Atom objects
522             Args : A Residue and an Atom
523              
524             =cut
525              
526             sub add_atom {
527 826     826 1 977 my($self,$residue,$atom) = @_;
528              
529 826 50       1768 if (ref($residue) !~ /^Bio::Structure::Residue/) {
530 0         0 $self->throw("add_atom: first argument needs to be a Residue object\n");
531             }
532 826 100       1022 if (defined $atom) {
533 657 100       1499 if (ref($atom) eq "ARRAY") {
    50          
534             # if the user passed in a reference to an array
535 1         1 for my $a ( @{$atom} ) {
  1         3  
536 3 50       14 if( ! $a->isa('Bio::Structure::Atom') ) {
537 0         0 $self->throw("$a is not an Atom\n");
538             }
539 3 50       4 if ( $self->_parent($a) ) {
540 0         0 $self->throw("$a already belongs to a parent\n");
541             }
542 3         19 $self->_parent($a, $residue);
543 3         14 $self->_child($residue, $a);
544             # stringify
545             #my $str_ref = "$self";
546             #$r->_grandparent($str_ref);
547             }
548             }
549             #elsif ( $atom->isa('Bio::Structure::Atom') ) {
550             elsif ( ref($atom) =~ /^Bio::Structure::Atom/ ) {
551 656 50       769 if ( $self->_parent($atom) ) {
552 0         0 $self->throw("$atom already belongs to a parent\n");
553             }
554 656         4222 $self->_parent($atom, $residue);
555 656         3023 $self->_child($residue, $atom);
556             # stringify
557             #my $str_ref = "$self";
558             #$atom->_grandparent($str_ref);
559             }
560             }
561 826         3066 my $array_ref = $self->_child($residue);
562 826 50       3983 return $array_ref ? @{$array_ref} : ();
  826         1060  
563             }
564              
565              
566             =head2 get_atoms()
567              
568             Title : get_atoms
569             Usage : $structure->get_atoms($residue);
570             Function: General get method for Atoms attached to a Residue
571             Returns : A list of Atoms attached to this Residue
572             Args : A Residue
573              
574             =cut
575              
576             sub get_atoms {
577 169     169 1 302 my ($self, $residue) = @_;
578              
579 169 50       192 if ( !defined $residue) {
580 0         0 $self->throw("get_atoms needs a Residue as argument");
581             }
582             # pass through to add_atom
583 169         161 $self->add_atom($residue);
584             }
585              
586              
587             =head2 parent()
588              
589             Title : parent
590             Usage : $structure->parent($residue);
591             Function: Returns the parent of the argument
592             Returns : The parent of the argument
593             Args : A Bio::Structure object
594              
595             =cut
596              
597             =head2 connect
598              
599             Title : connect
600             Usage :
601             Function: Alias to conect()
602             Returns :
603             Args :
604              
605             =cut
606              
607             sub connect {
608 0     0 1 0 my $self = shift;
609 0         0 return $self->conect(@_);
610             }
611              
612             =head2 conect()
613              
614             Title : conect
615             Usage : $structure->conect($source);
616             Function: Get/set method for conect
617             Returns : A list of serial numbers for Atoms connected to source
618             (together with $entry->get_atom_by_serial($model, $serial),
619             this should be OK for now)
620             Args : The source, the serial number for the source Atom, and the type
621              
622             =cut
623              
624             sub conect {
625 40     40 1 33 my ($self, $source, $serial, $type) = @_;
626            
627 40 50       54 if ( !defined $source ) {
628 0         0 $self->throw("You need to supply at least a source to connect");
629             }
630 40 100 66     91 if ( defined $serial && defined $type ) {
631 32 100 66     25 if ( !exists(${$self->{'conect'}}{$source}) ||
  32         60  
632 13         45 ref(${$self->{'conect'}}{$source} !~ /^ARRAY/ ) ) {
633 19         13 ${$self->{'conect'}}{$source} = [];
  19         42  
634             }
635             # we also need to store type, a conect object might be better
636 32         39 my $c = $serial . "_" . $type;
637 32         19 push @{ ${$self->{'conect'}}{$source} }, $c;
  32         19  
  32         48  
638             }
639             # Bug 1894
640             return () if ( !exists $self->{'conect'}{$source} ||
641 40 50 33     98 !defined $self->{'conect'}{$source} );
642 40         23 return @{ ${$self->{'conect'}}{$source} };
  40         24  
  40         72  
643             }
644              
645             =head2 get_all_connect_source
646              
647             Title : get_all_connect_source
648             Usage :
649             Function: Alias to get_all_conect_source()
650             Returns :
651             Args :
652              
653             =cut
654              
655             sub get_all_connect_source {
656 0     0 1 0 my $self = shift;
657 0         0 return get_all_conect_source(@_);
658             }
659              
660             =head2 get_all_conect_source()
661              
662             Title : get_all_conect_source
663             Usage : @sources = $structure->get_all_conect_source;
664             Function: Get all the sources for the conect records
665             Returns : A list of serial numbers for atoms connected to source
666             (together with $entry->get_atom_by_serial($model, $serial),
667             this should be OK for now)
668             Args :
669             Notes : This is a bit of a kludge, but it is the best for now. Conect info might need
670             to go in a separate object
671              
672             =cut
673              
674             sub get_all_conect_source {
675 1     1 1 2 my ($self) = shift;
676 1         3 my (@sources);
677              
678 1         3 for my $source (sort {$a<=>$b} keys %{$self->{'conect'}}) {
  17         15  
  1         12  
679 8         9 push @sources, $source;
680             }
681 1         5 return @sources;
682             }
683              
684              
685             =head2 master()
686              
687             Title : master
688             Usage : $structure->master($source);
689             Function: Get/set method for master
690             Returns : The master line
691             Args : The master line for this entry
692              
693             =cut
694              
695             sub master {
696 3     3 1 3 my ($self, $value) = @_;
697 3 100       9 if (defined $value) {
698 2         5 $self->{'master'} = $value;
699             }
700 3         5 return $self->{'master'};
701             }
702              
703              
704             =head2 seqres()
705              
706             Title : seqres
707             Usage : $seqobj = $structure->seqres("A");
708             Function: Gets a sequence object containing the sequence from the SEQRES record.
709             if a chain-ID is given, the sequence for this chain is given, if none
710             is provided the first chain is chosen
711             Returns : A Bio::PrimarySeq
712             Args : The chain-ID of the chain you want the sequence from
713              
714             =cut
715              
716             sub seqres {
717 1     1 1 2 my ($self, $chainid) = @_;
718 1         1 my $s_u = "x3 A1 x7 A3 x1 A3 x1 A3 x1 A3 x1 A3 x1 A3 x1 A3 x1 A3 x1 A3 x1 A3 x1 A3 x1 A3 x1 A3";
719 1         2 my (%seq_ch);
720 1 50       3 if ( !defined $chainid) {
721 1         4 my $m = ($self->get_models($self))[0];
722 1         2 my $c = ($self->get_chains($m))[0];
723 1         5 $chainid = $c->id;
724             }
725 1         4 my $seqres = ($self->annotation->get_Annotations("seqres"))[0];
726 1         4 my $seqres_string = $seqres->as_text;
727 1         9 $self->debug("seqres : $seqres_string\n");
728 1         5 $seqres_string =~ s/^Value: //;
729             # split into lines of 62 long
730 1         7 my @l = unpack("A62" x (length($seqres_string)/62), $seqres_string);
731 1         3 for my $line (@l) {
732             # get out chain_id and sequence
733             # we use a1, as A1 strips all spaces :(
734 5         10 my ($chid, $seq) = unpack("x3 a1 x7 A51", $line);
735 5 50       11 if ($chid eq " ") {
736 5         5 $chid = "default";
737             }
738 5         46 $seq =~ s/(\w+)/\u\L$1/g; # ALA -> Ala (for SeqUtils)
739 5         21 $seq =~ s/\s//g; # strip all spaces
740 5         8 $seq_ch{$chid} .= $seq;
741 5         13 $self->debug("seqres : $chid $seq_ch{$chid}\n");
742             }
743             # do we have a seqres for this chainid
744 1 50       3 if(! exists $seq_ch{$chainid} ) {
745 0         0 $self->warn("There is no SEQRES known for chainid \"$chainid\"");
746 0         0 return;
747             }
748              
749             # this will break for non-protein structures (about 10% for now) XXX KB
750 1         10 my $pseq = Bio::PrimarySeq->new(-alphabet => 'protein');
751 1         8 $pseq = Bio::SeqUtils->seq3in($pseq,$seq_ch{$chainid});
752 1         3 my $id = $self->id . "_" . $chainid;
753 1         4 $pseq->id($id);
754 1         4 return $pseq;
755             }
756              
757              
758             =head2 get_atom_by_serial()
759              
760             Title : get_atom_by_serial
761             Usage : $structure->get_atom_by_serial($model,$serial);
762             Function: Get the Atom by serial
763             Returns : The Atom object with this serial number in the model
764             Args : Model on which to work, serial number for atom
765             (if only a number is supplied, the first model is chosen)
766              
767             =cut
768              
769             sub get_atom_by_serial {
770 1     1 1 2 my ($self, $model, $serial) = @_;
771              
772 1 50 33     11 if ($model =~ /^\d+$/ && !defined $serial) { # only serial given
773 1         2 $serial = $model;
774 1         3 my @m = $self->get_models($self);
775 1         3 $model = $m[0];
776             }
777 1 50 33     6 if ( !defined $model || ref($model) !~ /^Bio::Structure::Model/ ) {
778 0         0 $self->throw("Could not find (first) model\n");
779             }
780 1 50 33     6 if ( !defined $serial || ($serial !~ /^\d+$/) ) {
781 0         0 $self->throw("The serial number you provided looks fishy ($serial)\n");
782             }
783 1         3 for my $chain ($self->get_chains($model) ) {
784 1         3 for my $residue ($self->get_residues($chain) ) {
785 46         47 for my $atom ($self->get_atoms($residue) ) {
786             # this could get expensive, do we cache ???
787 367 100       369 next unless ($atom->serial == $serial);
788 1         4 return $atom;
789             }
790             }
791             }
792             }
793              
794             sub parent {
795 13     13 1 923 my ($self, $obj) = @_;
796            
797 13 50       24 if ( !defined $obj) {
798 0         0 $self->throw("parent: you need to supply an argument to get the parent from\n");
799             }
800              
801             # for now we pass on to _parent, untill we get the symbolic ref thing working.
802 13         19 $self->_parent($obj);
803             }
804              
805             sub DESTROY {
806 4     4   11 my $self = shift;
807              
808 4         8 %{ $self->{'p_c'} } = ();
  4         22  
809 4         287 %{ $self->{'c_p'} } = ();
  4         12  
810             }
811              
812             =head2 annotation
813              
814             Title : annotation
815             Usage : $obj->annotation($seq_obj)
816             Function:
817             Example :
818             Returns : value of annotation
819             Args : newvalue (optional)
820              
821             =cut
822              
823             sub annotation {
824 117     117 1 94 my ($obj,$value) = @_;
825 117 100       150 if( defined $value) {
826 4         7 $obj->{'annotation'} = $value;
827             }
828 117         224 return $obj->{'annotation'};
829             }
830              
831              
832             #
833             # from here on only private methods
834             #
835              
836             =head2 _remove_models()
837              
838             Title : _remove_models
839             Usage :
840             Function: Removes the models attached to an Entry. Tells the models they
841             do not belong to this Entry any more
842             Returns :
843             Args :
844              
845             =cut
846              
847             #
848              
849             sub _remove_models {
850 0     0   0 my ($self) = shift;
851              
852             ;
853             }
854              
855              
856             =head2 _create_default_model()
857              
858             Title : _create_default_model
859             Usage :
860             Function: Creates a default Model for this Entry. Typical situation
861             in an X-ray structure where there is only one model
862             Returns :
863             Args :
864              
865             =cut
866              
867             sub _create_default_model {
868 0     0   0 my ($self) = shift;
869              
870 0         0 my $model = Bio::Structure::Model->new(-id => "default");
871 0         0 return $model;
872             }
873              
874              
875             =head2 _create_default_chain()
876              
877             Title : _create_default_chain
878             Usage :
879             Function: Creates a default Chain for this Model. Typical situation
880             in an X-ray structure where there is only one chain
881             Returns :
882             Args :
883              
884             =cut
885              
886             sub _create_default_chain {
887 0     0   0 my ($self) = shift;
888              
889 0         0 my $chain = Bio::Structure::Chain->new(-id => "default");
890 0         0 return $chain;
891             }
892              
893              
894              
895             =head2 _parent()
896              
897             Title : _parent
898             Usage : This is an internal function only. It is used to have one
899             place that keeps track of which object has which other object
900             as parent. Thus allowing the underlying modules (Atom, Residue,...)
901             to have no knowledge about all this (and thus removing the possibility
902             of reference cycles).
903             This method hides the details of manipulating references to an anonymous
904             hash.
905             Function: To get/set an objects parent
906             Returns : A reference to the parent if it exist, undef otherwise. In the
907             current implementation each node should have a parent (except Entry).
908             Args :
909              
910             =cut
911              
912             # manipulating the c_p hash
913              
914             sub _parent {
915 2     2   9 no strict "refs";
  2         2  
  2         879  
916 1678     1678   1347 my ($self, $key, $value) = @_;
917              
918 1678 50 33     3879 if ( (!defined $key) || (ref($key) !~ /^Bio::/) ) {
919 0         0 $self->throw("First argument to _parent needs to be a reference to a Bio:: object ($key)\n");
920             }
921 1678 50 66     3697 if ( (defined $value) && (ref($value) !~ /^Bio::/) ) {
922 0         0 $self->throw("Second argument to _parent needs to be a reference to a Bio:: object\n");
923             }
924             # no checking here for consistency of key and value, needs to happen in caller
925              
926 1678 100       1931 if (defined $value) {
927             # is this value already in, shout
928 826 0 33     1589 if (defined ( $self->{'c_p'}->{$key}) &&
929             exists ( $self->{'c_p'}->{$key})
930             ) {
931 0         0 $self->throw("_parent: $key already has a parent ${$self->{'c_p'}}{$key}\n");
  0         0  
932             }
933 826         3760 ${$self->{'c_p'}}{$key} = $value;
  826         1882  
934             }
935 1678         4634 return ${$self->{'c_p'}}{$key};
  1678         4371  
936             }
937              
938              
939             =head2 _child()
940              
941             Title : _child
942             Usage : This is an internal function only. It is used to have one
943             place that keeps track of which object has which other object
944             as child. Thus allowing the underlying modules (Atom, Residue,...)
945             to have no knowledge about all this (and thus removing the possibility
946             to have no knowledge about all this (and thus removing the possibility
947             of reference cycles).
948             This method hides the details of manipulating references to an anonymous
949             hash.
950             Function: To get/set an the children of an object
951             Returns : A reference to an array of child(ren) if they exist, undef otherwise.
952             Args :
953              
954             =cut
955              
956             # manipulating the p_c hash
957             sub _child {
958 1840     1840   1307 my ($self, $key, $value) = @_;
959            
960 1840 50 33     4709 if ( (!defined $key) || (ref($key) !~ /^Bio::/) ) {
961 0         0 $self->throw("First argument to _child needs to be a reference to a Bio:: object\n");
962             }
963 1840 50 66     3734 if ( (defined $value) && (ref($value) !~ /^Bio::/) ) {
964 0         0 $self->throw("Second argument to _child needs to be a reference to a Bio:: object\n");
965             }
966             # no checking here for consistency of key and value, needs to happen in caller
967            
968 1840 100       2109 if (defined $value) {
969 826 100 66     534 if ( !exists(${$self->{'p_c'}}{$key}) || ref(${$self->{'p_c'}}{$key}) !~ /^ARRAY/ ) {
  826         1893  
  656         3487  
970 170         716 ${$self->{'p_c'}}{$key} = [];
  170         382  
971             }
972 826         4869 push @{ ${$self->{'p_c'}}{$key} }, $value;
  826         525  
  826         1619  
973             }
974 1840         4370 return ${$self->{'p_c'}}{$key};
  1840         3477  
975             }
976              
977             =head2 _remove_from_graph()
978              
979             Title : _remove_from_graph
980             Usage : This is an internal function only. It is used to remove from
981             the parent/child graph. We only remove the links from object to
982             his parent. Not the ones from object to its children.
983             Function: To remove an object from the parent/child graph
984             Returns :
985             Args : The object to be orphaned
986              
987             =cut
988              
989             sub _remove_from_graph {
990 5     5   3 my ($self, $object) = @_;
991            
992 5 0 33     9 if ( !defined($object) && ref($object) !~ /^Bio::/) {
993 0         0 $self->throw("_remove_from_graph needs a Bio object as argument");
994             }
995 5 50       5 if ( $self->_parent($object) ) {
996 0           my $dad = $self->_parent($object);
997             # if we have a parent, remove me as being a child
998 0           for my $k (0 .. $#{$self->_child($dad)}) {
  0            
999 0 0         if ($object eq ${$self->{'p_c'}{$dad}}[$k]) {
  0            
1000 0           splice(@{$self->{'p_c'}{$dad}}, $k,1);
  0            
1001             }
1002             }
1003 0           delete( $self->{'c_p'}{$object});
1004             }
1005             }
1006              
1007            
1008             sub _print_stats_pc {
1009             # print stats about the parent/child hashes
1010 0     0     my ($self) =@_;
1011 0           my $pc = scalar keys %{$self->{'p_c'}};
  0            
1012 0           my $cp = scalar keys %{$self->{'c_p'}};
  0            
1013 0           my $now_time = Time::HiRes::time();
1014 0           $self->debug("pc stats: P_C $pc C_P $cp $now_time\n");
1015             }
1016              
1017              
1018             1;