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