1 package DBIx::Class::Storage::DBI;
5 use base qw/DBIx::Class/;
7 __PACKAGE__->load_components(qw/SQL::Abstract SQL Exception AccessorGroup/);
9 __PACKAGE__->mk_group_accessors('simple' => qw/connect_info _dbh/);
12 bless({}, ref $_[0] || $_[0]);
16 my ($self, $get) = @_;
21 my ($self, $set, $val) = @_;
22 return $self->{$set} = $val;
27 DBIx::Class::Storage::DBI - DBI storage handler
33 This class represents the connection to the database
44 unless (($dbh = $self->_dbh) && $dbh->FETCH('Active') && $dbh->ping) {
52 my @info = @{$self->connect_info || []};
53 $self->_dbh($self->_connect(@info));
57 my ($self, @info) = @_;
58 return DBI->connect(@info);
65 Issues a commit again the current dbh
69 sub commit { $_[0]->dbh->commit; }
75 Issues a rollback again the current dbh
79 sub rollback { $_[0]->dbh->rollback; }
82 my ($self, $ident, $to_insert) = @_;
83 my $sql = $self->create_sql('insert', [ keys %{$to_insert} ], $ident, undef);
84 my $sth = $self->sth($sql);
85 $sth->execute(values %{$to_insert});
86 $self->throw( "Couldn't insert ".join(%to_insert)." into ${ident}" )
92 my ($self, $ident, $to_update, $condition) = @_;
94 my $set_sql = $self->_cond_resolve($to_update, $attrs, ',');
97 my $cond_sql = $self->_cond_resolve($condition, $attrs);
98 my $sql = $self->create_sql('update', $set_sql, $ident, $cond_sql);
99 my $sth = $self->sth($sql);
100 my $rows = $sth->execute( @{$attrs->{bind}||[]} );
105 my ($self, $ident, $condition) = @_;
107 my $cond_sql = $self->_cond_resolve($condition, $attrs);
108 my $sql = $self->create_sql('delete', undef, $ident, $cond_sql);
109 #warn "$sql ".join(', ',@{$attrs->{bind}||[]});
110 my $sth = $self->sth($sql);
111 return $sth->execute( @{$attrs->{bind}||[]} );
115 my ($self, $ident, $select, $condition, $attrs) = @_;
117 #my $select_sql = $self->_cond_resolve($select, $attrs, ',');
118 my $cond_sql = $self->_cond_resolve($condition, $attrs);
119 1 while $cond_sql =~ s/^\s*\(\s*(.*ORDER.*)\s*\)\s*$/$1/;
120 my $sql = $self->create_sql('select', $select, $ident, $cond_sql);
121 #warn $sql.' '.join(', ', @{$attrs->{bind}||[]});
122 my $sth = $self->sth($sql);
123 if (@{$attrs->{bind}||[]}) {
124 $sth->execute( @{$attrs->{bind}||[]} );
132 shift->dbh->prepare(@_);
141 Matt S. Trout <perl-stuff@trout.me.uk>
145 You may distribute this code under the same terms as Perl itself.