Skip to content
Newer
Older
100644 439 lines (332 sloc) 12.2 KB
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
1 # $Id$
2 #
3 # BioPerl module for Bio::DB::DBI::base
4 #
5c669cb adding FEEDBACK:Support section to pod
maj authored Feb 21, 2009
5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 #
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
7 # Cared for by Hilmar Lapp <hlapp at gmx.net>
8 #
9 # Copyright Hilmar Lapp
10 #
11 # You may distribute this module under the same terms as perl itself
12
13 #
14 # (c) Hilmar Lapp, hlapp at gmx.net, 2002.
15 # (c) GNF, Genomics Institute of the Novartis Research Foundation, 2002.
16 #
17 # You may distribute this module under the same terms as perl itself.
18 # Refer to the Perl Artistic License (see the license accompanying this
19 # software package, or see http://www.perl.com/language/misc/Artistic.html)
20 # for the terms under which you may use, modify, and redistribute this module.
21 #
22 # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
23 # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
24 # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
25 #
26
27 # POD documentation - main docs before the code
28
29 =head1 NAME
30
31 Bio::DB::DBI::base - base class for drivers implementing Bio::DB::DBI
32
33 =head1 DESCRIPTION
34
167339e @heikkil POD fixes
heikkil authored Jun 3, 2003
35 Don't instantiate this module directly. Instead instantiate one of the
36 derived classes.
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
37
38 =head1 FEEDBACK
39
40 =head2 Mailing Lists
41
42 User feedback is an integral part of the evolution of this and other
167339e @heikkil POD fixes
heikkil authored Jun 3, 2003
43 Bioperl modules. Send your comments and suggestions preferably to the
44 Bioperl mailing list. Your participation is much appreciated.
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
45
a2036ab @arareko Updating mailing lists URL
arareko authored Jul 1, 2006
46 bioperl-l@bioperl.org - General discussion
47 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
48
5c669cb adding FEEDBACK:Support section to pod
maj authored Feb 21, 2009
49 =head2 Support
26048f6 some pod cleaning
cjfields authored Sep 29, 2009
50
5c669cb adding FEEDBACK:Support section to pod
maj authored Feb 21, 2009
51 Please direct usage questions or support issues to the mailing list:
26048f6 some pod cleaning
cjfields authored Sep 29, 2009
52
53 I<bioperl-l@bioperl.org>
54
5c669cb adding FEEDBACK:Support section to pod
maj authored Feb 21, 2009
55 rather than to the module maintainer directly. Many experienced and
56 reponsive experts will be able look at the problem and quickly
57 address it. Please include a thorough description of the problem
58 with code and data examples if at all possible.
59
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
60 =head2 Reporting Bugs
61
62 Report bugs to the Bioperl bug tracking system to help us keep track
63 of the bugs and their resolution. Bug reports can be submitted via
7c35bd4 @arareko Updated bug reporting
arareko authored Jul 4, 2006
64 the web:
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
65
0224021 @hyphaltip buzgilla -> redmine
hyphaltip authored Mar 28, 2011
66 http://redmine.open-bio.org/projects/bioperl/
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
67
68 =head1 AUTHOR - Hilmar Lapp
69
70 Email hlapp at gmx.net
71
72 Describe contact details here
73
74 =head1 CONTRIBUTORS
75
7f207d2 add dbcontext method, store dbcontext in the constructor, and let get…
juguang authored Dec 9, 2003
76 Juguang Xiao, juguang at tll.org.sg
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
77
78 =head1 APPENDIX
79
80 The rest of the documentation details each of the object methods.
81 Internal methods are usually preceded with a _
82
83 =cut
84
dd1b84d @hlapp Fixed the Oracle driver. All tests pass except the one testing for the
hlapp authored Oct 18, 2002
85 #'
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
86 # Let the code begin...
87
88
89 package Bio::DB::DBI::base;
90 use vars qw(@ISA);
91 use strict;
92 use Bio::DB::DBI;
93
94 # Object preamble - inherits from Bio::Root::Root
95
96 use Bio::Root::Root;
97
98 @ISA = qw(Bio::Root::Root Bio::DB::DBI);
99
100 =head2 new
101
102 Title : new
103 Usage :
104 Function: should only be called by derived classes
105 Returns :
106 Args : named parameters with tags -dbcontext (a Bio::DB::DBContextI
107 implementing object) and -sequence_name (the name of the sequence
108 for PK generation)
109
110
111 =cut
112
113 sub new {
114 my($class,@args) = @_;
115
116 my $self = $class->SUPER::new(@args);
117
118 my ($dbc, $seqname) = $self->_rearrange([qw(DBCONTEXT SEQUENCE_NAME)],
119 @args);
120
121 $self->{'_dbh_pools'} = {};
122 $self->{'_conn_params'} = {};
7f207d2 add dbcontext method, store dbcontext in the constructor, and let get…
juguang authored Dec 9, 2003
123 $dbc && $self->dbcontext($dbc);
964e503 @hlapp Oracle driver and schema driver. The rest is fixes.
hlapp authored Oct 17, 2002
124 $self->sequence_name($seqname) if defined($seqname);
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
125
126 return $self;
127 }
128
129 =head2 sequence_name
130
131 Title : sequence_name
132 Usage : $obj->sequence_name($newval)
133 Function: Sets/Gets the name of the sequence to be used for PK generation if
134 that name is not passed to the respective method as an argument.
135 Example :
136 Returns : value of sequence_name (a scalar)
137 Args : new value (a scalar, optional)
138
139
140 =cut
141
142 sub sequence_name{
143 my ($self,$value) = @_;
144 if( defined $value) {
145 $self->{'sequence_name'} = $value;
146 }
147 return $self->{'sequence_name'};
148 }
149
150 =head2 build_dsn
151
152 Title : build_dsn
153 Usage :
154 Function: Constructs the DSN string from the DBContextI object. Since this
155 may be driver-specific, specific implementations may need to
156 override this method.
157 Example :
158 Returns : a string (the DSN)
159 Args : a Bio::DB::DBContextI implementing object
160
161
162 =cut
163
164 sub build_dsn{
165 my ($self,$dbc) = @_;
166
31741ce @hlapp Added dsn property to DBContextI. Added -dsn option and dsn() impleme…
hlapp authored Aug 26, 2005
167 my $dsn = $dbc->dsn();
168 if (! defined($dsn)) {
169 $dsn = "DBI:" . $dbc->driver() . ":database=" . $dbc->dbname();
170 $dsn .= ";host=" . $dbc->host() if $dbc->host();
171 $dsn .= ";port=" . $dbc->port() if $dbc->port();
172 }
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
173 return $dsn;
174 }
175
176 =head2 get_connection
177
178 Title : get_connection
179 Usage :
167339e @heikkil POD fixes
heikkil authored Jun 3, 2003
180 Function: Obtains a connection handle to the database represented by
181 the the DBContextI object, passing additional args to the
182 DBI->connect() method if a new connection is created.
183
184 Contrary to new_connection(), this method will return
185 shared connections from a pool. The implementation makes
186 sure though that the returned handle was opened with the
187 given parameters.
188
189 In addition, the caller must not disconnect the obtained
190 handle deliberately. Instead, the implementing object will
191 disconnect and dispose of open handles once it is being
192 garbage collected, or once disconnect() is called with the
193 same or no parameters.
194
195 Specific drivers usually won''t need to override this
196 method but rather build_dsn().
197
198 This implementation will call new_connection() to actually
199 get a new connection if needed.
200
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
201 Example :
202 Returns : an open DBI database handle
203 Args : A Bio::DB::DBContextI implementing object. Additional hashref
204 parameter to be passed to DBI->connect().
205
206
207 =cut
208
209 sub get_connection{
210 my ($self,$dbc,$params) = @_;
7f207d2 add dbcontext method, store dbcontext in the constructor, and let get…
juguang authored Dec 9, 2003
211
212 # The below line is added by Juguang.
213 # Well, I cannot see why the dbc needs to be re-assigned here again.
214 $dbc ||= $self->dbcontext;
215
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
216 my @keyvalues = $params ? %$params : ("default");
217 # note that in the end the key doesn't carry meaning any more; the goal is
218 # rather to ensure that two invocations with the same dbcontext object and
219 # a hashref containing the same keys and values result in the same key
220 my $poolkey = "$dbc" . join(";", sort(@keyvalues));
221
222 if(! exists($self->{'_dbh_pools'}->{$poolkey})) {
223 $self->{'_dbh_pools'}->{$poolkey} = [];
224 }
225
226 my $connpool = $self->{'_dbh_pools'}->{$poolkey};
227 if(! @$connpool) {
228 push(@$connpool, $self->new_connection($dbc,$params));
229 }
230 return $connpool->[0];
231 }
232
233 =head2 new_connection
234
235 Title : new_connection
236 Usage :
237 Function: Obtains a new connection handle to the database represented by the
238 the DBContextI object, passing additional args to the DBI->connect()
239 method.
240
241 This method is supposed to always open a new connection. Also, the
242 implementing class is expected to release proper disconnection of
243 the handle entirely to the caller.
244
245 Specific drivers usually won''t need to override this method but
246 rather build_dsn().
247 Example :
248 Returns : an open DBI database handle
249 Args : A Bio::DB::DBContextI implementing object. Additional hashref
250 parameter to pass to DBI->connect().
251
252
253 =cut
254
255 sub new_connection{
256 my ($self,$dbc,$params) = @_;
257
258 $self->throw("mandatory argument dbcontext not supplied (internal error?)")
259 unless $dbc;
260 my $dsn = $self->build_dsn($dbc);
51a4dff bug 2387
cjfields authored Oct 23, 2007
261 $self->debug("new_connection(): dsn=$dsn; user=" . (defined $dbc->username() ? $dbc->username() : 'undef') ."\n"); # undef: postgres 'ident sameuser' login
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
262
263 my $dbh;
264 eval {
265 $dbh = DBI->connect($dsn, $dbc->username(), $dbc->password(), $params);
266 };
267 if ($@ || (! $dbh)) {
268 $self->throw("failed to open connection: " . $DBI::errstr);
269 }
270 return $dbh;
271 }
272
273 =head2 disconnect
274
275 Title : disconnect
276 Usage :
277 Function: Disconnects all or a certain number of connections matching the
278 parameters. The connections affected are those previously obtained
279 through get_connection() (shared connections from a pool).
280 Example :
281 Returns : none
282 Args : Optionally, a Bio::DB::DBContextI implementing object.
283 Additional hashref parameter with settings that were passed to
284 get_connection().
285
286
287 =cut
288
289 sub disconnect{
290 my ($self,$dbc,$params) = @_;
291 my @connpools = ();
292
293 if(! $dbc) {
294 # disconnect all pools that we have
295 map { push(@connpools, $_); } (values %{$self->{'_dbh_pools'}});
296 } else {
297 my @keyvalues = $params ? %$params : ("default");
298 # note that in the end the key doesn't carry meaning any more; the goal
299 # is rather to ensure that two invocations with the same dbcontext
300 # object and a hashref containing the same keys and values result in
301 # the same key
302 my $poolkey = "$dbc" . join(";", sort(@keyvalues));
303 if(exists($self->{'_dbh_pools'}->{$poolkey})) {
304 push(@connpools, $self->{'_dbh_pools'}->{$poolkey});
305 }
306 }
307 # do they actual disconnection
308 foreach my $cpool (@connpools) {
309 while(@$cpool) {
310 my $dbh = shift(@$cpool);
311 next unless $dbh; # during DESTROY there are indeed undef values --
312 # I have no idea where they come from
313 eval {
964e503 @hlapp Oracle driver and schema driver. The rest is fixes.
hlapp authored Oct 17, 2002
314 $self->_remove_idsths($dbh);
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
315 $dbh->disconnect();
316 };
317 $self->warn("error while closing connection: ".$@) if $@;
318 }
319 }
320 }
321
322 =head2 conn_params
323
324 Title : conn_params
325 Usage : $dbi->conn_params($requestor, $newval)
6827b2f @hlapp I've got comments working to the extent that they are stored, and can be
hlapp authored Oct 3, 2002
326 Function: Gets/sets connection parameters suitable for the specific
327 driver and the specific requestor.
328
329 A particular implementation may choose to ignore the
330 requestor, but it may also use it to return different
331 parameters, based on, e.g., which interface the requestor
332 implements. Usually the caller will pass $self as the value
333 $requestor, but an implementation is expected to accept
334 a class or interface name as well.
335
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
336 Example :
337 Returns : a hashref to be passed to get_connection() or new_connection()
338 (which would pass it on to DBI->connect()).
6827b2f @hlapp I've got comments working to the extent that they are stored, and can be
hlapp authored Oct 3, 2002
339 Args : The requesting object, or alternatively its class name or
340 interface.
341 Optionally, on set the new value (which must be undef or a
342 hashref).
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
343
344
345 =cut
346
347 sub conn_params{
348 my ($self,$req,$params) = @_;
349 my $reqclass = ref($req) || $req;
350
351 if( defined $params) {
352 $self->{'_conn_params'}->{$reqclass} = $params;
353 } else {
354 # we try the class directly first
355 if(exists($self->{'_conn_params'}->{$reqclass})) {
356 $params = $self->{'_conn_params'}->{$reqclass};
357 } elsif(ref($req)) {
358 # for an object, try whether we have something for an interface
359 # it implements
360 foreach my $parent (keys %{$self->{'_conn_params'}}) {
361 if($req->isa($parent)) {
362 $params = $self->{'_conn_params'}->{$parent};
363 last;
364 }
365 }
366 }
367 $params = {} unless $params; # default is empty hash
368 }
369 return $params;
370 }
371
964e503 @hlapp Oracle driver and schema driver. The rest is fixes.
hlapp authored Oct 17, 2002
372 =head2 _idsth
373
374 Title : _idsth
375 Usage : $obj->_idsth($newval)
376 Function: Get/set the last/next id value statement handle from/to
377 the cache.
378
379 Consider this method 'protected' in OO-speak. I.e., call it
380 from derived modules, but not from outside.
381
382 Example :
383 Returns : a last_id_value or next_id_value prepared statement, or all
384 statements cached under the database handle if the key literal
385 is omitted
386 Args : the database handle for which to cache the statement,
387 a key literal to distinguish between statements (e.g.,
388 'last' and 'next'),
389 and optionall on set the statement handle to cache
390
391
392 =cut
393
394 sub _idsth{
395 my ($self,$dbh,$key) = @_;
396
397 $self->{'_idsth_$dbh'} = {} unless exists($self->{'_idsth_$dbh'});
398 return values %{$self->{'_idsth_$dbh'}} unless $key;
399 return $self->{'_idsth_$dbh'}->{$key} = shift if @_;
400 return $self->{'_idsth_$dbh'}->{$key};
401 }
402
403 =head2 _remove_idsths
404
405 Title : _remove_idsths
406 Usage :
407 Function: Un-caches all prepared statement handles cached under the
408 given handle.
409 Example :
410 Returns : the list of previously cached statement handles
411 Args : the database handle
412
413
414 =cut
415
416 sub _remove_idsths{
417 my ($self,$dbh) = @_;
418
419 return () unless exists($self->{'_idsth_$dbh'});
420 my @sths = values %{$self->{'_idsth_$dbh'}};
421 delete $self->{'_idsth_$dbh'};
422 return @sths;
423 }
424
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
425 sub DESTROY {
426 my ($self) = @_;
427
428 $self->disconnect();
429 $self->SUPER::DESTROY;
430 }
431
7f207d2 add dbcontext method, store dbcontext in the constructor, and let get…
juguang authored Dec 9, 2003
432 sub dbcontext {
433 my $self =shift;
434 $self->{_dbcontext}=shift if @_;
435 return $self->{_dbcontext};
436 }
437
e5c9002 @hlapp First commit of re-structured and re-written biosql adaptors.
hlapp authored Oct 1, 2002
438 1;
Something went wrong with that request. Please try again.