Add tests for memory leaks and weaken for Issue #81
[bioperl-live.git] / Bio / Structure / Model.pm
blobf3b483dc372b3b04064bf0f7a0ed0b3d1609de99
2 # bioperl module for Bio::Structure::Model
4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 # Cared for by Kris Boulez <kris.boulez@algonomics.com>
8 # Copyright Kris Boulez
10 # You may distribute this module under the same terms as perl itself
12 # POD documentation - main docs before the code
14 =head1 NAME
16 Bio::Structure::Model - Bioperl structure Object, describes a Model
18 =head1 SYNOPSIS
20 #add synopsis here
22 =head1 DESCRIPTION
24 This object stores a Bio::Structure::Chain
26 =head1 FEEDBACK
28 =head2 Mailing Lists
30 User feedback is an integral part of the evolution of this and other
31 Bioperl modules. Send your comments and suggestions preferably to one
32 of the Bioperl mailing lists. Your participation is much appreciated.
34 bioperl-l@bioperl.org - General discussion
35 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
37 =head2 Support
39 Please direct usage questions or support issues to the mailing list:
41 I<bioperl-l@bioperl.org>
43 rather than to the module maintainer directly. Many experienced and
44 reponsive experts will be able look at the problem and quickly
45 address it. Please include a thorough description of the problem
46 with code and data examples if at all possible.
48 =head2 Reporting Bugs
50 Report bugs to the Bioperl bug tracking system to help us keep track
51 the bugs and their resolution. Bug reports can be submitted via the web:
53 https://github.com/bioperl/bioperl-live/issues
55 =head1 AUTHOR - Kris Boulez
57 Email kris.boulez@algonomics.com
59 =head1 APPENDIX
61 The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
63 =cut
66 # Let the code begin...
68 package Bio::Structure::Model;
69 use strict;
71 use Bio::Structure::Entry;
72 use Bio::Structure::Chain;
73 use base qw(Bio::Root::Root);
76 =head2 new()
78 Title : new()
79 Usage : $struc = Bio::Structure::Model->new(
80 -id => 'human_id',
83 Function: Returns a new Bio::Structure::Model object from basic
84 constructors. Probably most called from Bio::Structure::IO.
85 Returns : a new Bio::Structure::Model object
87 =cut
91 sub new {
92 my ($class, @args) = @_;
93 my $self = $class->SUPER::new(@args);
95 my($id, $chain, $residue ) =
96 $self->_rearrange([qw(
98 CHAIN
99 RESIDUE
101 @args);
103 $id && $self->id($id);
105 $chain && $self->throw("you have to add chain via an Entry object\n");
107 $residue && $self->throw("you have to add residues via an Entry object\n");
109 return $self;
114 =head2 chain()
116 Title : chain
117 Usage :
118 Function: will eventually allow parent/child navigation not via an Entry object
119 Returns :
120 Args :
122 =cut
124 sub chain {
125 my ($self,$value) = @_;
127 $self->throw("go via an Entry object\n");
131 =head2 add_chain()
133 Title : add_chain
134 Usage :
135 Function: will eventually allow parent/child navigation not via an Entry object
136 Returns :
137 Args :
139 =cut
141 sub add_chain {
142 my ($self,$value) = @_;
144 $self->throw("go via an Entry object for now\n");
147 =head2 entry()
149 Title : entry
150 Usage :
151 Function: will eventually allow parent/child navigation not via an Entry object
152 Returns :
153 Args :
155 =cut
157 sub entry {
158 my($self) = @_;
160 $self->throw("Model::entry go via an Entry object please\n");
164 =head2 id()
166 Title : id
167 Usage : $model->id("model 5")
168 Function: Gets/sets the ID for this model
169 Returns : the ID
170 Args : the ID
172 =cut
174 sub id {
175 my ($self, $value) = @_;;
176 if (defined $value) {
177 $self->{'id'} = $value;
179 return $self->{'id'};
182 =head2 residue()
184 Title : residue
185 Usage :
186 Function: will eventually allow parent/child navigation not via an Entry object
187 Returns :
188 Args :
190 =cut
192 sub residue {
193 my ($self, @args) = @_;
195 $self->throw("need to go via Entry object or learn symbolic refs\n");
199 =head2 add_residue()
201 Title : add_residue
202 Usage :
203 Function: will eventually allow parent/child navigation not via an Entry object
204 Returns :
205 Args :
207 =cut
209 sub add_residue {
210 my ($self, @args) = @_;
212 $self->throw("go via entry->add_residue(chain, residue)\n");
217 sub DESTROY {
218 my $self = shift;
220 # no specific DESTROY for now
224 # from here on only private methods
227 =head2 _remove_chains()
229 Title : _remove_chains
230 Usage :
231 Function: Removes the chains attached to a Model. Tells the chains they
232 don't belong to this Model any more
233 Returns :
234 Args :
236 =cut
238 sub _remove_chains {
239 my ($self) = shift;
241 $self->throw("use Entry methods pleae\n");
245 =head2 _remove_entry()
247 Title : _remove_entry
248 Usage :
249 Function: Removes the Entry this Model is atttached to.
250 Returns :
251 Args :
253 =cut
255 sub _remove_entry {
256 my ($self) = shift;
258 $self->throw("use a method based on an Entry object\n");
262 =head2 _create_default_chain()
264 Title : _create_default_chain
265 Usage :
266 Function: Creates a default Chain for this Model. Typical situation
267 in an X-ray structure where there is only one chain
268 Returns :
269 Args :
271 =cut
273 sub _create_default_chain {
274 my ($self) = shift;
276 my $chain = Bio::Structure::Chain->new(-id => "default");
280 =head2 _grandparent()
282 Title : _grandparent
283 Usage :
284 Function: get/set a symbolic reference to our grandparent
285 Returns :
286 Args :
288 =cut
290 sub _grandparent {
291 my($self,$symref) = @_;
293 if (ref($symref)) {
294 $self->throw("Thou shall only pass strings in here, no references $symref\n");
296 if (defined $symref) {
297 $self->{'grandparent'} = $symref;
299 return $self->{'grandparent'};