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 =item connection
  48
  49   __PACKAGE__->connection($dsn, $user, $pass, $attrs);
  50
  51 Specifies the arguments that will be passed to DBI->connect(...) to
  52 instantiate the class dbh when required.
  53
  54 =cut
  55
  56 sub connection {
  57   my ($class, @info) = @_;
  58   $class->_dbi_connect_package($class);
  59   $class->_dbi_connect_info(\@info);
  60 }
  61
  62 =item dbi_commit
  63
  64   $class->dbi_commit;
  65
  66 Issues a commit again the current dbh
  67
  68 =cut
  69
  70 sub dbi_commit { $_[0]->_get_dbh->commit; }
  71
  72 =item dbi_rollback
  73
  74   $class->dbi_rollback;
  75
  76 Issues a rollback again the current dbh
  77
  78 =cut
  79
  80 sub dbi_rollback { $_[0]->_get_dbh->rollback; }
  81
  82 1;
  83
  84 =back
  85
  86 =head1 AUTHORS
  87
  88 Matt S. Trout <perl-stuff@trout.me.uk>
  89
  90 =head1 LICENSE
  91
  92 You may distribute this code under the same terms as Perl itself.
  93
  94 =cut
  95