Add tests for memory leaks and weaken for Issue #81
[bioperl-live.git] / Bio / Map / TranscriptionFactor.pm
blob9769aa0226ab84b5e095e5dbebc35bb57db43063
1 # $Id: TranscriptionFactor.pm,v 1.6 2006/07/17 14:16:53 sendu Exp $
3 # BioPerl module for Bio::Map::TranscriptionFactor
5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
7 # Cared for by Sendu Bala <bix@sendu.me.uk>
9 # Copyright Sendu Bala
11 # You may distribute this module under the same terms as perl itself
13 # POD documentation - main docs before the code
15 =head1 NAME
17 Bio::Map::TranscriptionFactor - A transcription factor modelled as a mappable
18 element
20 =head1 SYNOPSIS
22 use Bio::Map::TranscriptionFactor;
23 use Bio::Map::GeneMap;
24 use Bio::Map::Position;
26 # model a TF that binds 500bp upstream of the BRCA2 gene in humans and
27 # 250bp upstream of BRCA2 in mice
28 my $tf = Bio::Map::TranscriptionFactor->get(-universal_name => 'tf1');
29 my $map1 = Bio::Map::GeneMap->get(-universal_name => "BRCA2",
30 -species => "human");
31 my $map2 = Bio::Map::GeneMap->get(-universal_name => "BRCA2",
32 -species => "mouse");
33 Bio::Map::Position->new(-map => $map1,
34 -element => $tf,
35 -start => -500,
36 -length => 10);
37 Bio::Map::Position->new(-map => $map2,
38 -element => $tf,
39 -start => -250,
40 -length => 10);
42 # Find out where the transcription factor binds
43 foreach $pos ($tf->get_positions) {
44 print $tf->universal_name, " binds at position " $pos->value, " relative to ",
45 $pos->relative->description, " of gene ",
46 $pos->map->universal_name, " in species ", $pos->map->species, "\n";
49 =head1 DESCRIPTION
51 A transcription factor modelled as a mappable element. It can have mulitple
52 binding sites (positions) near multiple genes (maps).
54 =head1 FEEDBACK
56 =head2 Mailing Lists
58 User feedback is an integral part of the evolution of this and other
59 Bioperl modules. Send your comments and suggestions preferably to the
60 Bioperl mailing list. Your participation is much appreciated.
62 bioperl-l@bioperl.org - General discussion
63 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
65 =head2 Support
67 Please direct usage questions or support issues to the mailing list:
69 I<bioperl-l@bioperl.org>
71 rather than to the module maintainer directly. Many experienced and
72 reponsive experts will be able look at the problem and quickly
73 address it. Please include a thorough description of the problem
74 with code and data examples if at all possible.
76 =head2 Reporting Bugs
78 Report bugs to the Bioperl bug tracking system to help us keep track
79 of the bugs and their resolution. Bug reports can be submitted via the
80 web:
82 https://github.com/bioperl/bioperl-live/issues
84 =head1 AUTHOR - Sendu Bala
86 Email bix@sendu.me.uk
88 =head1 APPENDIX
90 The rest of the documentation details each of the object methods.
91 Internal methods are usually preceded with a _
93 =cut
95 # Let the code begin...
97 package Bio::Map::TranscriptionFactor;
98 use strict;
100 use base qw(Bio::Map::Mappable);
102 our $TFS = {};
104 =head2 new
106 Title : new
107 Usage : my $tf = Bio::Map::TranscriptionFactor->new();
108 Function: Builds a new Bio::Map::TranscriptionFactor object
109 Returns : Bio::Map::TranscriptionFactor
110 Args : -universal_name => string name of the TF (in a form common to all
111 species that have the TF, but unique amongst
112 non-orthologous TFs), REQUIRED
113 -description => string, free text description of the TF
115 =cut
117 sub new {
118 my ($class, @args) = @_;
119 my $self = $class->SUPER::new(@args);
121 my ($u_name, $desc) = $self->_rearrange([qw(UNIVERSAL_NAME DESCRIPTION)], @args);
122 $u_name || $self->throw("You must supply a -universal_name");
123 $self->universal_name($u_name);
125 defined $desc && $self->description($desc);
127 return $self;
130 =head2 get
132 Title : get
133 Usage : my $obj = Bio::Map::TranscriptionFactor->get();
134 Function: Builds a new Bio::Map::TranscriptionFactor object (like new()), or
135 gets a pre-existing one that shares the same universal_name.
136 Returns : Bio::Map::TranscriptionFactor
137 Args : -universal_name => string name of the TF (in a form common to all
138 species that have the TF, but unique amongst
139 non-orthologous TFs), REQUIRED
140 -description => string, free text description of the TF
142 =cut
144 sub get {
145 my ($class, @args) = @_;
146 my ($u_name) = Bio::Root::Root->_rearrange([qw(UNIVERSAL_NAME)], @args);
148 if ($u_name && defined $TFS->{$u_name}) {
149 return $TFS->{$u_name};
152 return $class->new(@args);
155 =head2 universal_name
157 Title : universal_name
158 Usage : my $name = $obj->universal_name
159 Function: Get/Set TF name, corresponding to the name of the TF in a form shared
160 by orthologous versions of the TF in different species, but otherwise
161 unique.
162 Returns : string
163 Args : none to get, OR string to set
165 =cut
167 sub universal_name {
168 my ($self, $value) = @_;
169 if (defined $value) {
170 delete $TFS->{$self->{'_uname'}} if $self->{'_uname'};
171 $self->{'_uname'} = $value;
172 $TFS->{$value} = $self;
174 return $self->{'_uname'};
177 =head2 description
179 Title : description
180 Usage : my $desc = $obj->description
181 Function: Get/Set a description of the TF.
182 Returns : string
183 Args : none to get, OR string to set
185 =cut
187 sub description {
188 my $self = shift;
189 if (@_) { $self->{desc} = shift }
190 return $self->{desc} || '';