~ubuntu-branches/ubuntu/lucid/bioperl/lucid

« back to all changes in this revision

Viewing changes to Bio/DB/Ace.pm

  • Committer: Bazaar Package Importer
  • Author(s): Matt Hope
  • Date: 2002-03-20 01:16:30 UTC
  • Revision ID: james.westby@ubuntu.com-20020320011630-wyvmxwc7o5bi4665
Tags: upstream-1.0
ImportĀ upstreamĀ versionĀ 1.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
 
 
2
# $Id: Ace.pm,v 1.9 2001/06/18 15:53:42 dag Exp $
 
3
#
 
4
# BioPerl module for Bio::DB::Ace
 
5
#
 
6
# Cared for by Ewan Birney <birney@sanger.ac.uk>
 
7
#
 
8
# Copyright Ewan Birney
 
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::DB::Ace - Database object interface to ACeDB servers
 
17
 
 
18
=head1 SYNOPSIS
 
19
 
 
20
    $db = Bio::DB::Ace->new( -server => 'myace.server.com', port => '120000');
 
21
 
 
22
    $seq = $db->get_Seq_by_id('MUSIGHBA1'); # Unique ID
 
23
 
 
24
    # or ...
 
25
 
 
26
    $seq = $db->get_Seq_by_acc('J00522'); # Accession Number
 
27
 
 
28
=head1 DESCRIPTION
 
29
 
 
30
This provides a standard BioPerl database access to Ace, using Lincoln Steins
 
31
excellent AcePerl module. You need to download and install the aceperl module from
 
32
 
 
33
  http://stein.cshl.org/AcePerl/
 
34
 
 
35
before this interface will work.
 
36
 
 
37
This interface is designed at the moment to work through a aceclient/aceserver
 
38
type mechanism
 
39
 
 
40
=head1 INSTALLING ACEPERL
 
41
 
 
42
Download the latest aceperl tar file, gunzip/untar and cd into the directory.
 
43
This is a standard CPAN-style directory, so if you go
 
44
 
 
45
  Perl Makefile.PL
 
46
  make
 
47
  <become root>
 
48
  make install
 
49
 
 
50
Then you will have installed Aceperl. Use the PREFIX mechanism to install elsewhere.
 
51
 
 
52
=head1 FEEDBACK
 
53
 
 
54
=head2 Mailing Lists
 
55
 
 
56
User feedback is an integral part of the evolution of this
 
57
and other Bioperl modules. Send your comments and suggestions preferably
 
58
 to one of the Bioperl mailing lists.
 
59
Your participation is much appreciated.
 
60
 
 
61
  bioperl-l@bioperl.org              - General discussion
 
62
  http://bioperl.org/MailList.shtml  - About the mailing lists
 
63
 
 
64
=head2 Reporting Bugs
 
65
 
 
66
Report bugs to the Bioperl bug tracking system to help us keep track
 
67
 the bugs and their resolution.
 
68
 Bug reports can be submitted via email or the web:
 
69
 
 
70
  bioperl-bugs@bio.perl.org
 
71
  http://bio.perl.org/bioperl-bugs/
 
72
 
 
73
=head1 AUTHOR - Ewan Birney
 
74
 
 
75
Email birney@sanger.ac.uk
 
76
 
 
77
=head1 APPENDIX
 
78
 
 
79
The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
 
80
 
 
81
=cut
 
82
 
 
83
# Let the code begin...
 
84
 
 
85
package Bio::DB::Ace;
 
86
use vars qw(@ISA);
 
87
use strict;
 
88
 
 
89
# Object preamble - inherits from Bio::DB::RandomAccessI
 
90
 
 
91
use Bio::DB::RandomAccessI;
 
92
use Bio::Seq;
 
93
 
 
94
BEGIN { 
 
95
  eval {
 
96
    require Ace;
 
97
  };
 
98
  if( $@) {
 
99
    print STDERR "You have not installed Ace.pm.\n Read the docs in Bio::DB::Ace for more information about how to do this.\n It is very easy\n\nError message $@";
 
100
  }
 
101
}
 
102
 
 
103
 
 
104
@ISA = qw(Bio::DB::RandomAccessI);
 
105
 
 
106
# new() is inherited from Bio::DB::Abstract
 
107
 
 
108
# _initialize is where the heavy stuff will happen when new is called
 
109
 
 
110
sub new {
 
111
  my($class,@args) = @_;
 
112
  my $self = $class->SUPER::new(@args);
 
113
  my ($host,$port) = $self->_rearrange([qw(
 
114
                                         HOST
 
115
                                         PORT
 
116
                                         )],
 
117
                                     @args,
 
118
                                     );
 
119
 
 
120
  if( !$host || !$port ) {
 
121
    $self->throw("Must have a host and port for an acedb server to work");
 
122
  }
 
123
 
 
124
  my $aceobj = Ace->connect(-host => $host,
 
125
                            -port => $port) ||
 
126
                              $self->throw("Could not make acedb object to $host:$port");
 
127
 
 
128
  $self->_aceobj($aceobj);
 
129
 
 
130
 
 
131
  return $self;
 
132
}
 
133
 
 
134
=head2 get_Seq_by_id
 
135
 
 
136
 Title   : get_Seq_by_id
 
137
 Usage   : $seq = $db->get_Seq_by_id($uid);
 
138
 Function: Gets a Bio::Seq object by its unique identifier/name
 
139
 Returns : a Bio::Seq object
 
140
 Args    : $id : the id (as a string) of the desired sequence entry
 
141
 
 
142
=cut
 
143
 
 
144
sub get_Seq_by_id {
 
145
  my $self = shift;
 
146
  my $id = shift or $self->throw("Must supply an identifier!\n");
 
147
  my $ace = $self->_aceobj();
 
148
  my ($seq,$dna,$out);
 
149
 
 
150
  $seq = $ace->fetch( 'Sequence' , $id);
 
151
 
 
152
  # get out the sequence somehow!
 
153
 
 
154
  $dna = $seq->asDNA();
 
155
  
 
156
  $dna =~ s/^>.*\n//;
 
157
  $dna =~ s/\n//g;
 
158
 
 
159
  $out = Bio::Seq->new( -id => $id, -type => 'Dna', -seq => $dna, -name => "Sequence from Bio::DB::Ace $id");
 
160
  return $out;
 
161
 
 
162
}
 
163
 
 
164
=head2 get_Seq_by_acc
 
165
 
 
166
  Title   : get_Seq_by_acc
 
167
  Usage   : $seq = $db->get_Seq_by_acc($acc);
 
168
  Function: Gets a Bio::Seq object by its accession number
 
169
  Returns : a Bio::Seq object
 
170
  Args    : $acc : the accession number of the desired sequence entry
 
171
 
 
172
 
 
173
=cut
 
174
 
 
175
sub get_Seq_by_acc {
 
176
 
 
177
  my $self = shift;
 
178
  my $acc = shift or $self->throw("Must supply an accesion number!\n");
 
179
  
 
180
  return $self->get_Seq_by_id($acc);
 
181
}
 
182
 
 
183
=head2 _aceobj
 
184
 
 
185
  Title   : _aceobj
 
186
  Usage   : $ace = $db->_aceobj();
 
187
  Function: Get/Set on the acedb object 
 
188
  Returns : Ace object
 
189
  Args    : New value of the ace object
 
190
 
 
191
=cut
 
192
 
 
193
sub _aceobj {
 
194
  my ($self,$arg) = @_;
 
195
 
 
196
  if( $arg ) {
 
197
    $self->{'_aceobj'} = $arg;
 
198
  } 
 
199
 
 
200
  return $self->{'_aceobj'};
 
201
}
 
202
 
 
203
1;
 
204
 
 
205
 
 
206
 
 
207
 
 
208
 
 
209