ensembl-hive  2.6
CoreDBConnection.pm
Go to the documentation of this file.
1 =head1 LICENSE
2 
3 Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
4 Copyright [2016-2024] EMBL-European Bioinformatics Institute
5 
6 Licensed under the Apache License, Version 2.0 (the "License");
7 you may not use this file except in compliance with the License.
8 You may obtain a copy of the License at
9 
10  http://www.apache.org/licenses/LICENSE-2.0
11 
12 Unless required by applicable law or agreed to in writing, software
13 distributed under the License is distributed on an "AS IS" BASIS,
14 WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15 See the License for the specific language governing permissions and
16 limitations under the License.
17 
18 =cut
19 
20 
21 =head1 CONTACT
22 
23  Please email comments or questions to the public Ensembl
24  developers list at <dev@ensembl.org>.
25 
26  Questions may also be sent to the Ensembl help desk at
27  <helpdesk@ensembl.org>.
28 
29 =cut
30 
31 =head1 NAME
32 
34 
35 =head1 SYNOPSIS
36 
38  -user => 'anonymous',
39  -dbname => 'homo_sapiens_core_20_34c',
40  -host => 'ensembldb.ensembl.org',
41  -driver => 'mysql',
42  );
43 
44  # SQL statements should be created/executed through this modules
45  # prepare() and do() methods.
46 
47  $sth = $dbc->prepare("SELECT something FROM yourtable");
48 
49  $sth->execute();
50 
51  # do something with rows returned ...
52 
53  $sth->finish();
54 
55 =head1 DESCRIPTION
56 
57 This class is a wrapper around DBIs datbase handle. It provides some
58 additional functionality such as the ability to automatically disconnect
59 when inactive and reconnect when needed.
60 
61 Generally this class will be used through one of the object adaptors or
62 the Bio::EnsEMBL::Registry and will not be instantiated directly.
63 
64 =head1 METHODS
65 
66 =cut
67 
68 
70 
71 use strict;
72 no strict 'refs';
73 use warnings;
74 
75 use DBI;
77 
78 use Bio::EnsEMBL::Hive::Utils ('throw');
80 
81 
82 use vars qw(@ISA); # If Ensembl Core code is available, inherit from its' DBConnection for compatibility.
83 BEGIN {
84  if (eval { require Bio::EnsEMBL::DBSQL::DBConnection; 1 }) {
85  @ISA = ('Bio::EnsEMBL::DBSQL::DBConnection');
86  } else {
87  @ISA = ();
88  }
89 }
90 
91 
92 =head2 new
93 
94  Arg [DBNAME] : (optional) string
95  The name of the database to connect to.
96  Arg [HOST] : (optional) string
97  The domain name of the database host to connect to.
98  'localhost' by default.
99  Arg [USER] : string
100  The name of the database user to connect with
101  Arg [PASS] : (optional) string
102  The password to be used to connect to the database
103  Arg [PORT] : (optional) int
104  The port to use when connecting to the database
105  3306 by default if the driver is mysql.
106  Arg [DRIVER] : (optional) string
107  The type of database driver to use to connect to the DB
108  mysql by default.
109  Arg [DBCONN] : (optional)
110  Open another handle to the same database as another connection
111  If this argument is specified, no other arguments should be
112  specified.
113  Arg [DISCONNECT_WHEN_INACTIVE]: (optional) boolean
114  If set to true, the database connection will be disconnected
115  everytime there are no active statement handles. This is
116  useful when running a lot of jobs on a compute farm
117  which would otherwise keep open a lot of connections to the
118  database. Database connections are automatically reopened
119  when required.Do not use this option together with RECONNECT_WHEN_LOST.
120  Arg [WAIT_TIMEOUT]: (optional) integer
121  Time in seconds for the wait_timeout to happen. Time after which
122  the connection is deleted if not used. By default this is 28800 (8 hours)
123  on most systems.
124  So set this to greater than this if your connection are getting deleted.
125  Only set this if you are having problems and know what you are doing.
126  Arg [RECONNECT_WHEN_LOST]: (optional) boolean
127  In case you're reusing the same database connection, i.e. DISCONNECT_WHEN_INACTIVE is
128  set to false and running a job which takes a long time to process (over 8hrs),
129  which means that the db connection may be lost, set this option to true.
130  On each prepare or do statement the db handle will be pinged and the database
131  connection will be reconnected if it's lost.
132 
133  Example : $dbc = Bio::EnsEMBL::DBSQL::DBConnection->new
134  (-user => 'anonymous',
135  -dbname => 'homo_sapiens_core_20_34c',
136  -host => 'ensembldb.ensembl.org',
137  -driver => 'mysql');
138 
139  Description: Constructor for a Database Connection. Any adaptors that require
140  database connectivity should inherit from this class.
142  Exceptions : thrown if USER or DBNAME are not specified, or if the database
143  cannot be connected to.
144  Caller : Bio::EnsEMBL::Utils::ConfigRegistry ( for newer code using the registry)
145  Bio::EnsEMBL::DBSQL::DBAdaptor ( for old style code)
146  Status : Stable
147 
148 =cut
149 
150 sub new {
151  my $class = shift @_;
152  my %flags = @_;
153 
154  my ($driver, $user, $password, $host, $port, $dbname,
155  $dbconn, $disconnect_when_inactive, $wait_timeout, $reconnect_when_lost)
156  = @flags{qw(-driver -user -pass -host -port -dbname -dbconn
157  -disconnect_when_inactive -wait_timeout -reconnect_when_lost)};
158 
159  my $self = {};
160  bless $self, $class;
161 
162  if($dbconn) {
163  if($dbname || $host || $driver || $password || $port || $disconnect_when_inactive || $reconnect_when_lost) {
164  throw("Cannot specify other arguments when -DBCONN argument used.");
165  }
166 
167  $self->driver($dbconn->driver());
168  $self->host($dbconn->host());
169  $self->port($dbconn->port());
170  $self->username($dbconn->username());
171  $self->password($dbconn->password());
172  $self->dbname($dbconn->dbname());
173 
174  if($dbconn->disconnect_when_inactive()) {
175  $self->disconnect_when_inactive(1);
176  }
177  } else {
178  $driver ||= 'mysql';
179 
180  if($driver eq 'mysql') {
181  $user || throw("-USER argument is required.");
182  $host ||= 'mysql';
183  if(!defined($port)){
184  $port = 3306;
185  if($host eq "ensembldb.ensembl.org"){
186  if( $dbname =~ /\w+_\w+_\w+_(\d+)/){
187  if($1 >= 48){
188  $port = 5306;
189  }
190  }
191  }
192  }
193  } elsif($driver eq 'pgsql') {
194  if(!defined($port)){
195  $port = 5432;
196  }
197  }
198 
199  $self->driver($driver);
200  $self->host( $host );
201  $self->port($port);
202  $self->username( $user );
203  $self->password( $password );
204  $self->dbname( $dbname );
205  $self->wait_timeout($wait_timeout);
206 
207  if($disconnect_when_inactive) {
208  $self->disconnect_when_inactive($disconnect_when_inactive);
209  }
210  if($reconnect_when_lost) {
211  $self->reconnect_when_lost($reconnect_when_lost);
212  }
213  }
214 
215 # if(defined $dnadb) {
216 # $self->dnadb($dnadb);
217 # }
218  return $self;
219 }
220 
221 
222 =head2 connect
223 
224  Example : $dbcon->connect()
225  Description: Connects to the database using the connection attribute
226  information.
227  Returntype : none
228  Exceptions : none
229  Caller : new, db_handle
230  Status : Stable
231 
232 =cut
233 
234 sub connect {
235  my ($self) = @_;
236 
237  if ( $self->connected() ) { return }
238 
239  $self->connected(1);
240 
241  if ( defined( $self->db_handle() ) and $self->db_handle()->ping() ) {
242  warn( "unconnected db_handle is still pingable, "
243  . "reseting connected boolean\n" );
244  }
245 
246  my ( $dsn, $dbh );
247  my $dbname = $self->dbname();
248 
249  if ( $self->driver() eq "Oracle" ) {
250 
251  $dsn = "DBI:Oracle:";
252 
253  eval {
254  $dbh = DBI->connect( $dsn,
255  sprintf( "%s@%s",
256  $self->username(), $dbname ),
257  $self->password(),
258  { 'RaiseError' => 1, 'PrintError' => 0 } );
259  };
260 
261  } elsif ( $self->driver() eq "ODBC" ) {
262 
263  $dsn = sprintf( "DBI:ODBC:%s", $self->dbname() );
264 
265  eval {
266  $dbh = DBI->connect( $dsn,
267  $self->username(),
268  $self->password(), {
269  'LongTruncOk' => 1,
270  'LongReadLen' => 2**16 - 8,
271  'RaiseError' => 1,
272  'PrintError' => 0,
273  'odbc_cursortype' => 2 } );
274  };
275 
276  } elsif ( $self->driver() eq "Sybase" ) {
277  my $dbparam = ($dbname) ? ";database=${dbname}" : q{};
278 
279  $dsn = sprintf( "DBI:Sybase:server=%s%s;tdsLevel=CS_TDS_495",
280  $self->host(), $dbparam );
281 
282  eval {
283  $dbh = DBI->connect( $dsn,
284  $self->username(),
285  $self->password(), {
286  'LongTruncOk' => 1,
287  'RaiseError' => 1,
288  'PrintError' => 0 } );
289  };
290 
291  } elsif ( lc( $self->driver() ) eq 'sqlite' ) {
292 
293  throw "We require a dbname to connect to a SQLite database"
294  if !$dbname;
295 
296  $dsn = sprintf( "DBI:SQLite:%s", $dbname );
297 
298  eval {
299  $dbh = DBI->connect( $dsn, '', '', { 'RaiseError' => 1, } );
300  };
301 
302  } else {
303 
304  my $dbparam = ($dbname) ? "database=${dbname};" : q{};
305 
306  my $driver = $self->driver();
307  $driver = 'Pg' if($driver eq 'pgsql');
308 
309  $dsn = sprintf( "DBI:%s:%shost=%s;port=%s",
310  $driver, $dbparam,
311  $self->host(), $self->port() );
312 
313  my $parameters = { 'RaiseError' => 1 };
314  $parameters->{'mysql_local_infile'} = 1 if lc($self->driver()) eq 'mysql';
315 
316  eval {
317  $dbh = DBI->connect( $dsn, $self->username(), $self->password(),
318  $parameters );
319  };
320  }
321  my $error = $@;
322 
323  if ( !$dbh || $error || !$dbh->ping() ) {
324  warn( "Could not connect to database "
325  . $self->dbname()
326  . " as user "
327  . $self->username()
328  . " using [$dsn] as a locator:\n"
329  . $error );
330 
331  $self->connected(0);
332 
333  throw( "Could not connect to database "
334  . $self->dbname()
335  . " as user "
336  . $self->username()
337  . " using [$dsn] as a locator:\n"
338  . $error );
339  }
340 
341  $self->db_handle($dbh);
342 
343  if ( $self->wait_timeout() ) {
344  my $driver = $self->driver();
345 
346  if( $driver eq 'mysql' ) {
347  $dbh->do( "SET SESSION wait_timeout=" . $self->wait_timeout() );
348  } else {
349  warn "Don't know how to set the wait_timeout for '$driver' driver, skipping.\n";
350  }
351  }
352 
353  #print("CONNECT\n");
354 } ## end sub connect
355 
356 
357 =head2 connected
358 
359  Example : $dbcon->connected()
360  Description: Boolean which tells if DBConnection is connected or not.
361  State is set internally, and external processes should not alter state.
362  Returntype : undef or 1
363  Exceptions : none
364  Caller : db_handle, connect, disconnect_if_idle, user processes
365  Status : Stable
366 
367 =cut
368 
369 sub connected {
370  my $self = shift;
371 
372  # Use the process id ($$) as part of the key for the connected flag.
373  # This forces the opening of another connection in a forked subprocess.
374  $self->{'connected'.$$} = shift if(@_);
375  return $self->{'connected'.$$};
376 }
377 
378 sub disconnect_count {
379  my $self = shift;
380  return $self->{'disconnect_count'} = shift if(@_);
381  $self->{'disconnect_count'}=0 unless(defined($self->{'disconnect_count'}));
382  return $self->{'disconnect_count'};
383 }
384 
385 sub wait_timeout{
386  my($self, $arg ) = @_;
387 
388  (defined $arg) &&
389  ($self->{_wait_timeout} = $arg );
390 
391  return $self->{_wait_timeout};
392 
393 }
394 
395 sub query_count {
396  my $self = shift;
397  return $self->{'_query_count'} = shift if(@_);
398  $self->{'_query_count'}=0 unless(defined($self->{'_query_count'}));
399  return $self->{'_query_count'};
400 }
401 
402 =head2 equals
403 
404  Example : warn 'Same!' if($dbc->equals($other_dbc));
405  Description: Equality checker for DBConnection objects
406  Returntype : boolean
407  Exceptions : none
408  Caller : new
409  Status : Stable
410 
411 =cut
412 
413 
414 sub equals {
415  my ( $self, $dbc ) = @_;
416  return 0 if ! defined $dbc;
417  my $return = 0;
418  my $undef_str = q{!-undef-!};
419  my $undef_num = -1;
420 
421  $return = 1 if (
422  (($self->host() || $undef_str) eq ($dbc->host() || $undef_str)) &&
423  (($self->dbname() || $undef_str) eq ($dbc->dbname() || $undef_str)) &&
424  (($self->port() || $undef_num) == ($dbc->port() || $undef_num)) &&
425  (($self->username() || $undef_str) eq ($dbc->username() || $undef_str)) &&
426  ($self->driver() eq $dbc->driver())
427  );
428 
429  return $return;
430 }
431 
432 =head2 driver
433 
434  Arg [1] : (optional) string $arg
435  the name of the driver to use to connect to the database
436  Example : $driver = $db_connection->driver()
437  Description: Getter / Setter for the driver this connection uses.
438  Right now there is no point to setting this value after a
439  connection has already been established in the constructor.
440  Returntype : string
441  Exceptions : none
442  Caller : new
443  Status : Stable
444 
445 =cut
446 
447 sub driver {
448  my($self, $arg ) = @_;
449 
450  (defined $arg) &&
451  ($self->{_driver} = $arg );
452  return $self->{_driver};
453 }
454 
455 
456 =head2 port
457 
458  Arg [1] : (optional) int $arg
459  the TCP or UDP port to use to connect to the database
460  Example : $port = $db_connection->port();
461  Description: Getter / Setter for the port this connection uses to communicate
462  to the database daemon. There currently is no point in
463  setting this value after the connection has already been
464  established by the constructor.
465  Returntype : string
466  Exceptions : none
467  Caller : new
468  Status : Stable
469 
470 =cut
471 
472 sub port {
473  my ( $self, $value ) = @_;
474 
475  if ( defined($value) ) {
476  $self->{'_port'} = $value;
477  }
478 
479  return $self->{'_port'};
480 }
481 
482 
483 =head2 dbname
484 
485  Arg [1] : (optional) string $arg
486  The new value of the database name used by this connection.
487  Example : $dbname = $db_connection->dbname()
488  Description: Getter/Setter for the name of the database used by this
489  connection. There is currently no point in setting this value
490  after the connection has already been established by the
491  constructor.
492  Returntype : string
493  Exceptions : none
494  Caller : new
495  Status : Stable
496 
497 =cut
498 
499 sub dbname {
500  my ($self, $arg ) = @_;
501  ( defined $arg ) &&
502  ( $self->{_dbname} = $arg );
503  $self->{_dbname};
504 }
505 
506 
507 =head2 username
508 
509  Arg [1] : (optional) string $arg
510  The new value of the username used by this connection.
511  Example : $username = $db_connection->username()
512  Description: Getter/Setter for the username used by this
513  connection. There is currently no point in setting this value
514  after the connection has already been established by the
515  constructor.
516  Returntype : string
517  Exceptions : none
518  Caller : new
519  Status : Stable
520 
521 =cut
522 
523 sub username {
524  my ($self, $arg ) = @_;
525  ( defined $arg ) &&
526  ( $self->{_username} = $arg );
527  $self->{_username};
528 }
529 
530 =head2 user
531 
532  Arg [1] : (optional) string $arg
533  The new value of the username used by this connection.
534  Example : $user = $db_connection->user()
535  Description: Convenience alias for the username method
536  Returntype : String
537 
538 =cut
539 
540 sub user {
541  my ($self, $arg) = @_;
542  return $self->username($arg);
543 }
544 
545 
546 =head2 host
547 
548  Arg [1] : (optional) string $arg
549  The new value of the host used by this connection.
550  Example : $host = $db_connection->host()
551  Description: Getter/Setter for the domain name of the database host use by
552  this connection. There is currently no point in setting
553  this value after the connection has already been established
554  by the constructor.
555  Returntype : string
556  Exceptions : none
557  Caller : new
558  Status : Stable
559 
560 =cut
561 
562 sub host {
563  my ($self, $arg ) = @_;
564  ( defined $arg ) &&
565  ( $self->{_host} = $arg );
566  $self->{_host};
567 }
568 
569 =head2 hostname
570 
571  Arg [1] : (optional) string $arg
572  The new value of the host used by this connection.
573  Example : $hostname = $db_connection->hostname()
574  Description: Convenience alias for the host method
575  Returntype : String
576 
577 =cut
578 
579 sub hostname {
580  my ($self, $arg) = @_;
581  return $self->host($arg);
582 }
583 
584 
585 =head2 password
586 
587  Arg [1] : (optional) string $arg
588  The new value of the password used by this connection.
589  Example : $host = $db_connection->password()
590  Description: Getter/Setter for the password of to use for this
591  connection. There is currently no point in setting
592  this value after the connection has already been
593  established by the constructor.
594  Returntype : string
595  Exceptions : none
596  Caller : new
597  Status : Stable
598 
599 =cut
600 
601 sub password {
602  my ( $self, $arg ) = @_;
603 
604  if ( defined($arg) ) {
605  # Use an anonymous subroutine that will return the password when
606  # invoked. This will prevent the password from being accidentally
607  # displayed when using e.g. Data::Dumper on a structure containing
608  # one of these objects.
609 
610  $self->{_password} = sub { $arg };
611  }
612 
613  return ( ref( $self->{_password} ) && &{ $self->{_password} } ) || '';
614 }
615 
616 =head2 pass
617 
618  Arg [1] : (optional) string $arg
619  The new value of the password used by this connection.
620  Example : $pass = $db_connection->pass()
621  Description: Convenience alias for the password method
622  Returntype : String
623 
624 =cut
625 
626 sub pass {
627  my ($self, $arg) = @_;
628  return $self->password($arg);
629 }
630 
631 =head2 disconnect_when_inactive
632 
633  Arg [1] : (optional) boolean $newval
634  Example : $dbc->disconnect_when_inactive(1);
635  Description: Getter/Setter for the disconnect_when_inactive flag. If set
636  to true this DBConnection will continually disconnect itself
637  when there are no active statement handles and reconnect as
638  necessary. Useful for farm environments when there can be
639  many (often inactive) open connections to a database at once.
640  Returntype : boolean
641  Exceptions : none
642  Caller : Pipeline
643  Status : Stable
644 
645 =cut
646 
647 sub disconnect_when_inactive {
648  my ( $self, $value ) = @_;
649 
650  if ( defined($value) ) {
651  $self->{'disconnect_when_inactive'} = $value;
652  if ($value) {
653  $self->disconnect_if_idle();
654  }
655  }
656 
657  return $self->{'disconnect_when_inactive'};
658 }
659 
660 
661 =head2 reconnect_when_lost
662 
663  Arg [1] : (optional) boolean $newval
664  Example : $dbc->reconnect_when_lost(1);
665  Description: Getter/Setter for the reconnect_when_lost flag. If set
666  to true the db handle will be pinged on each prepare or do statement
667  and the connection will be reestablished in case it's lost.
668  Useful for long running jobs (over 8hrs), which means that the db
669  connection may be lost.
670  Returntype : boolean
671  Exceptions : none
672  Caller : Pipeline
673  Status : Stable
674 
675 =cut
676 
677 sub reconnect_when_lost {
678  my ( $self, $value ) = @_;
679 
680  if ( defined($value) ) {
681  $self->{'reconnect_when_lost'} = $value;
682  }
683 
684  return $self->{'reconnect_when_lost'};
685 }
686 
687 
688 
689 =head2 locator
690 
691  Arg [1] : none
692  Example : $locator = $dbc->locator;
693  Description: Constructs a locator string for this database connection
694  that can, for example, be used by the DBLoader module
695  Returntype : string
696  Exceptions : none
697  Caller : general
698  Status : Stable
699 
700 =cut
701 
702 
703 sub locator {
704  my ($self) = @_;
705 
706  return sprintf(
707  "%s/host=%s;port=%s;dbname=%s;user=%s;pass=%s",
708  ref($self), $self->host(), $self->port(),
709  $self->dbname(), $self->username(), $self->password() );
710 }
711 
712 
713 =head2 db_handle
714 
715  Arg [1] : DBI Database Handle $value
716  Example : $dbh = $db_connection->db_handle()
717  Description: Getter / Setter for the Database handle used by this
718  database connection.
719  Returntype : DBI Database Handle
720  Exceptions : none
721  Caller : new, DESTROY
722  Status : Stable
723 
724 =cut
725 
726 sub db_handle {
727  my $self = shift;
728 
729  # Use the process id ($$) as part of the key for the database handle
730  # this makes this object fork safe. fork() does not makes copies
731  # of the open socket which creates problems when one of the forked
732  # processes disconnects,
733  return $self->{'db_handle'.$$} = shift if(@_);
734  return $self->{'db_handle'.$$} if($self->connected);
735 
736  $self->connect();
737  return $self->{'db_handle'.$$};
738 }
739 
740 
741 =head2 prepare
742 
743  Arg [1] : string $string
744  the SQL statement to prepare
745  Example : $sth = $db_connection->prepare("SELECT column FROM table");
746  Description: Prepares a SQL statement using the internal DBI database handle
747  and returns the DBI statement handle.
748  Returntype : DBI statement handle
749  Exceptions : thrown if the SQL statement is empty, or if the internal
750  database handle is not present
751  Caller : Adaptor modules
752  Status : Stable
753 
754 =cut
755 
756 sub prepare {
757  my $self = shift @_;
758  my $sql = shift @_;
759 
760  if( ! $sql ) {
761  throw("Attempting to prepare an empty SQL query.");
762  }
763 
764  #warn "SQL(".$self->dbname."): " . join(' ', $sql, @_) . "\n";
765  if ( ($self->reconnect_when_lost()) and (!$self->db_handle()->ping()) ) {
766  $self->reconnect();
767  }
768 
769  my $sth = Bio::EnsEMBL::Hive::DBSQL::StatementHandle->new( $self, $sql, @_ );
770 
771  $self->query_count($self->query_count()+1);
772  return $sth;
773 }
774 
775 =head2 reconnect
776 
777  Example : $dbcon->reconnect()
778  Description: Reconnects to the database using the connection attribute
779  information if db_handle no longer pingable.
780  Returntype : none
781  Exceptions : none
782  Caller : new, db_handle
783  Status : Stable
784 
785 =cut
786 
787 sub reconnect {
788  my ($self) = @_;
789  $self->connected(undef);
790  $self->db_handle(undef);
791  $self->connect();
792  return;
793 }
794 
795 
796 =head2 work_with_db_handle
797 
798  Arg [1] : CodeRef $callback
799  Example : my $q_t = $dbc->work_with_db_handle(sub { my ($dbh) = @_; return $dbh->quote_identifier('table'); });
800  Description: Gives access to the DBI handle to execute methods not normally
801  provided by the DBConnection interface
802  Returntype : Any from callback
803  Exceptions : If the callback paramater is not a CodeRef; all other
804  errors are re-thrown after cleanup.
805  Caller : Adaptor modules
806  Status : Stable
807 
808 =cut
809 
810 sub work_with_db_handle {
811  my ($self, $callback) = @_;
812  my $wantarray = wantarray;
813  if( $self->reconnect_when_lost() && !$self->db_handle()->ping()) {
814  $self->reconnect();
815  }
816  my @results;
817  eval {
818  if($wantarray) {
819  @results = $callback->($self->db_handle())
820  }
821  elsif(defined $wantarray) {
822  $results[0] = $callback->($self->db_handle());
823  }
824  else {
825  $callback->($self->db_handle());
826  }
827  };
828  my $original_error = $@;
829 
830  $self->query_count($self->query_count()+1);
831  eval {
832  if($self->disconnect_when_inactive()) {
833  $self->disconnect_if_idle();
834  }
835  };
836  if($@) {
837  warn "Detected an error whilst attempting to disconnect the DBI handle: $@";
838  }
839  if($original_error) {
840  throw "Detected an error when running DBI wrapper callback:\n$original_error";
841  }
842 
843  if(defined $wantarray) {
844  return ($wantarray) ? @results : $results[0];
845  }
846  return;
847 }
848 
849 =head2 prevent_disconnect
850 
851  Arg[1] : CodeRef $callback
852  Example : $dbc->prevent_disconnect(sub { $dbc->do('do something'); $dbc->do('something else')});
853  Description : A wrapper method which prevents database disconnection for the
854  duration of the callback. This is very useful if you need
855  to make multiple database calls avoiding excessive database
856  connection creation/destruction but still want the API
857  to disconnect after the body of work.
858 
859  The value of C<disconnect_when_inactive()> is set to 0 no
860  matter what the original value was & after $callback has
861  been executed. If C<disconnect_when_inactive()> was
862  already set to 0 then this method will be an effective no-op.
863  Returntype : None
864  Exceptions : Raised if there are issues with reverting the connection to its
865  default state.
866  Caller : DBConnection methods
867  Status : Beta
868 
869 =cut
870 
871 sub prevent_disconnect {
872  my ($self, $callback) = @_;
873  my $original_dwi = $self->disconnect_when_inactive();
874  $self->disconnect_when_inactive(0);
875  eval { $callback->(); };
876  my $original_error = $@;
877  eval {
878  $self->disconnect_when_inactive($original_dwi);
879  };
880  if($@) {
881  warn "Detected an error whilst attempting to reset disconnect_when_idle: $@";
882  }
883  if($original_error) {
884  throw "Detected an error when running DBI wrapper callback:\n$original_error";
885  }
886  return;
887 }
888 
889 
890 =head2 disconnect_if_idle
891 
892  Arg [1] : none
893  Example : $dbc->disconnect_if_idle();
894  Description: Disconnects from the database if there are no currently active
895  statement handles.
896  It is called automatically by the DESTROY method of the
897  Bio::EnsEMBL::Hive::DBSQL::StatementHandle if the
898  disconect_when_inactive flag is set.
899  Users may call it whenever they want to disconnect. Connection will
900  reestablish on next access to db_handle()
901  Returntype : 1 or 0
902  1=problem trying to disconnect while a statement handle was still active
903  Exceptions : none
904  Caller : Bio::EnsEMBL::Hive::DBSQL::StatementHandle::DESTROY
905  Bio::EnsEMBL::Hive::DBSQL::CoreDBConnection::do
906  Status : Stable
907 
908 =cut
909 
910 sub disconnect_if_idle {
911  my $self = shift;
912 
913  return 0 if(!$self->connected());
914  my $db_handle = $self->db_handle();
915  return 0 unless(defined($db_handle));
916 
917  #printf("disconnect_if_idle : kids=%d activekids=%d\n",
918  # $db_handle->{Kids}, $db_handle->{ActiveKids});
919 
920  #If InactiveDestroy is set, don't disconnect.
921  #To comply with DBI specification
922  return 0 if($db_handle->{InactiveDestroy});
923 
924  #If any statement handles are still active, don't allow disconnection
925  #In this case it is being called before a query has been fully processed
926  #either by not reading all rows of data returned, or not calling ->finish
927  #on the statement handle. Don't disconnect, send warning
928  if($db_handle->{ActiveKids} != 0) {
929  warn("Problem disconnect : kids=",$db_handle->{Kids},
930  " activekids=",$db_handle->{ActiveKids},"\n");
931  return 1;
932  }
933 
934  $db_handle->disconnect();
935  $self->connected(undef);
936  $self->disconnect_count($self->disconnect_count()+1);
937  #print("DISCONNECT\n");
938  $self->db_handle(undef);
939  return 0;
940 }
941 
942 
943 
944 #
945 # We have to redefine do() to avoid inheriting Core's do().
946 # However our do() is no different from any other DBI-enhanced methods in that they are all AUTOLOADed.
947 # So we switch off warnings and enforce AUTOLOADing.
948 #
949 
950 no warnings 'redefine';
951 sub do {
952  my $autoload = __PACKAGE__.'::AUTOLOAD';
953  $$autoload = __PACKAGE__.'::do';
954  goto &AUTOLOAD;
955 }
956 
957 
958 sub AUTOLOAD {
959  our $AUTOLOAD;
960 
961  $AUTOLOAD=~/^.+::(\w+)$/;
962  my $method_name = $1;
963 
964  # Mechanism to call on the dbc a db_handle method
965  # Used for "prepare" because the latter also exists on dbc
966  if ($method_name =~ /^protected_(.*)/) {
967  $method_name = $1;
968  }
969 
970 # warn "[AUTOLOAD instantiating '$method_name'] ($AUTOLOAD)\n";
971 
972  *$AUTOLOAD = sub {
973 # warn "[AUTOLOADed method '$method_name' running] ($AUTOLOAD)\n";
974 
975  my $self = shift @_;
976  my $db_handle = $self->db_handle() or throw( "db_handle returns false" );
977  my $wantarray = wantarray;
978 
979  my @retval;
980  eval {
981  #warn "SQL(".$self->dbname."): " . $_[0] . "\n" if ($method_name eq 'do') || ($method_name =~ /^select/);
982  if( $wantarray ) {
983  @retval = $db_handle->$method_name( @_ );
984  } else {
985  $retval[0] = $db_handle->$method_name( @_ );
986  }
987  1;
988  } or do {
989  my $error = $@;
991 
992  warn "trying to reconnect...";
993  # NOTE: parameters set via the hash interface of $dbh will be lost
994  $self->reconnect();
995  my $db_handle = $self->db_handle() or throw( "db_handle returns false" );
996 
997  warn "trying to re-$method_name...";
998  if( $wantarray ) {
999  @retval = $db_handle->$method_name( @_ );
1000  } else {
1001  $retval[0] = $db_handle->$method_name( @_ );
1002  }
1003  } else {
1004  throw( $error );
1005  }
1006  };
1007 
1008  if($self->disconnect_when_inactive() && ($method_name !~ /^prepare/)) { # we shouldn't disconnect right after prepare() otherwise the statement handle would be linked to a closed connection
1009  $self->disconnect_if_idle();
1010  }
1011 
1012  return $wantarray ? @retval : $retval[0];
1013  };
1014  goto &$AUTOLOAD;
1015 }
1016 
1017 
1018 sub DESTROY { } # needed because of AUTOLOAD
1019 
1020 1;
1021 
Bio::EnsEMBL::Hive::Utils
Definition: Collection.pm:4
Bio::EnsEMBL::DBSQL::DBAdaptor
Definition: DBAdaptor.pm:40
Bio::EnsEMBL::Utils::ConfigRegistry
Definition: ConfigRegistry.pm:23
Bio::EnsEMBL::Hive::Utils::SQLErrorParser
Definition: SQLErrorParser.pm:12
Bio::EnsEMBL::Hive::DBSQL::DBConnection
Definition: DBConnection.pm:20
Bio::EnsEMBL::Hive::DBSQL::StatementHandle
Definition: StatementHandle.pm:22
Bio::EnsEMBL::Registry
Definition: Registry.pm:113
Bio::EnsEMBL::DBSQL::DBConnection::prepare
public DBI prepare()
Bio::EnsEMBL::Hive::DBSQL::CoreDBConnection
Definition: CoreDBConnection.pm:41
Bio::EnsEMBL::DBSQL::DBConnection
Definition: DBConnection.pm:42
BEGIN
public BEGIN()
Bio::EnsEMBL::DBSQL::DBConnection::new
public Bio::EnsEMBL::DBSQL::DBConnection new()
Bio
Definition: AltAlleleGroup.pm:4
Bio::EnsEMBL::Hive::Utils::SQLErrorParser::is_connection_lost
public is_connection_lost()