1 package DBIx::Class::Storage::DBI;
6 use SQL::Abstract::Limit;
7 use DBIx::Class::Storage::DBI::Cursor;
9 use base qw/DBIx::Class/;
11 __PACKAGE__->load_components(qw/Exception AccessorGroup/);
13 __PACKAGE__->mk_group_accessors('simple' =>
14 qw/connect_info _dbh _sql_maker debug cursor/);
17 my $new = bless({}, ref $_[0] || $_[0]);
18 $new->cursor("DBIx::Class::Storage::DBI::Cursor");
19 $new->debug(1) if $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG};
24 my ($self, $get) = @_;
29 my ($self, $set, $val) = @_;
30 return $self->{$set} = $val;
35 DBIx::Class::Storage::DBI - DBI storage handler
41 This class represents the connection to the database
52 unless (($dbh = $self->_dbh) && $dbh->FETCH('Active') && $dbh->ping) {
60 unless ($self->_sql_maker) {
61 $self->_sql_maker(new SQL::Abstract::Limit( limit_dialect => $self->dbh ));
63 return $self->_sql_maker;
68 my @info = @{$self->connect_info || []};
69 $self->_dbh($self->_connect(@info));
73 my ($self, @info) = @_;
74 return DBI->connect(@info);
81 Issues a commit again the current dbh
85 sub commit { $_[0]->dbh->commit; }
91 Issues a rollback again the current dbh
95 sub rollback { $_[0]->dbh->rollback; }
98 my ($self, $op, $extra_bind, $ident, @args) = @_;
99 my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
100 unshift(@bind, @$extra_bind) if $extra_bind;
101 warn "$sql: @bind" if $self->debug;
102 my $sth = $self->sth($sql);
103 @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
104 my $rv = $sth->execute(@bind);
105 return (wantarray ? ($rv, $sth, @bind) : $rv);
109 my ($self, $ident, $to_insert) = @_;
110 $self->throw( "Couldn't insert ".join(', ', map "$_ => $to_insert->{$_}", keys %$to_insert)." into ${ident}" )
111 unless ($self->_execute('insert' => [], $ident, $to_insert) > 0);
116 return shift->_execute('update' => [], @_);
120 return shift->_execute('delete' => [], @_);
124 my ($self, $ident, $select, $condition, $attrs) = @_;
125 my $order = $attrs->{order_by};
126 if (ref $condition eq 'SCALAR') {
127 $order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
129 my @args = ('select', $attrs->{bind}, $ident, $select, $condition, $order);
130 if ($self->sql_maker->_default_limit_syntax eq "GenericSubQ") {
131 $attrs->{software_limit} = 1;
133 push @args, $attrs->{rows}, $attrs->{offset};
135 my ($rv, $sth, @bind) = $self->_execute(@args);
136 return $self->cursor->new($sth, \@bind, $attrs);
140 my ($self, $ident, $select, $condition, $attrs) = @_;
141 my $order = $attrs->{order_by};
142 if (ref $condition eq 'SCALAR') {
143 $order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
145 my @args = ('select', $attrs->{bind}, $ident, $select, $condition, $order);
146 if ($self->sql_maker->_default_limit_syntax eq "GenericSubQ") {
147 $attrs->{software_limit} = 1;
149 push @args, 1, $attrs->{offset};
151 my ($rv, $sth, @bind) = $self->_execute(@args);
152 return $sth->fetchrow_array;
156 shift->dbh->prepare(@_);
165 Matt S. Trout <mst@shadowcatsystems.co.uk>
167 Andy Grundman <andy@hybridized.org>
171 You may distribute this code under the same terms as Perl itself.