lib/DBIx/Class/DB.pm

   1 package DBIx::Class::DB;
   2
   3 use base qw/Class::Data::Inheritable/;
   4 use DBI;
   5
   6 __PACKAGE__->mk_classdata('_dbi_connect_info');
   7 __PACKAGE__->mk_classdata('_dbi_connect_package');
   8 __PACKAGE__->mk_classdata('_dbh');
   9
  10 =head1 NAME
  11
  12 DBIx::Class::DB - DBIx::Class Database connection
  13
  14 =head1 SYNOPSIS
  15
  16 =head1 DESCRIPTION
  17
  18 This class represents the connection to the database
  19
  20 =head1 METHODS
  21
  22 =over 4
  23
  24 =cut
  25
  26 sub _get_dbh {
  27   my ($class) = @_;
  28   my $dbh;
  29   unless (($dbh = $class->_dbh) && $dbh->FETCH('Active') && $dbh->ping) {
  30     $class->_populate_dbh;
  31   }
  32   return $class->_dbh;
  33 }
  34
  35 sub _populate_dbh {
  36   my ($class) = @_;
  37   my @info = @{$class->_dbi_connect_info || []};
  38   my $pkg = $class->_dbi_connect_package || $class;
  39   $pkg->_dbh($class->_dbi_connect(@info));
  40 }
  41
  42 sub _dbi_connect {
  43   my ($class, @info) = @_;
  44   return DBI->connect(@info);
  45 }
  46
  47 sub connection {
  48   my ($class, @info) = @_;
  49   $class->_dbi_connect_package($class);
  50   $class->_dbi_connect_info(\@info);
  51 }
  52
  53 sub dbi_commit { $_[0]->_get_dbh->commit; }
  54
  55 sub dbi_rollback { $_[0]->_get_dbh->rollback; }
  56
  57 1;
  58
  59 =back
  60
  61 =head1 AUTHORS
  62
  63 Matt S. Trout <perl-stuff@trout.me.uk>
  64
  65 =head1 LICENSE
  66
  67 You may distribute this code under the same terms as Perl itself.
  68
  69 =cut
  70