use strict;
use warnings;
use DBI;
-use SQL::Abstract;
-use DBIx::Class::Cursor;
+use SQL::Abstract::Limit;
+use DBIx::Class::Storage::DBI::Cursor;
use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/SQL SQL::Abstract Exception AccessorGroup/);
+__PACKAGE__->load_components(qw/Exception AccessorGroup/);
__PACKAGE__->mk_group_accessors('simple' =>
- qw/connect_info _dbh sql_maker debug cursor/);
+ qw/connect_info _dbh _sql_maker debug cursor/);
sub new {
my $new = bless({}, ref $_[0] || $_[0]);
- $new->sql_maker(new SQL::Abstract);
- $new->cursor("DBIx::Class::Cursor");
- #$new->debug(1);
+ $new->cursor("DBIx::Class::Storage::DBI::Cursor");
+ $new->debug(1) if $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG};
return $new;
}
return $self->_dbh;
}
+sub sql_maker {
+ my ($self) = @_;
+ unless ($self->_sql_maker) {
+ $self->_sql_maker(new SQL::Abstract::Limit( limit_dialect => $self->dbh ));
+ }
+ return $self->_sql_maker;
+}
+
sub _populate_dbh {
my ($self) = @_;
my @info = @{$self->connect_info || []};
unshift(@bind, @$extra_bind) if $extra_bind;
warn "$sql: @bind" if $self->debug;
my $sth = $self->sth($sql);
- @bind = map { ref $_ ? ''.$_ : $_ } @bind;
- my $rv = $sth->execute(@bind); # stringify args
+ @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
+ my $rv = $sth->execute(@bind);
return (wantarray ? ($rv, $sth, @bind) : $rv);
}
return shift->_execute('delete' => [], @_);
}
-sub select {
+sub _select {
my ($self, $ident, $select, $condition, $attrs) = @_;
my $order = $attrs->{order_by};
if (ref $condition eq 'SCALAR') {
$order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
}
- my ($rv, $sth, @bind) = $self->_execute('select', $attrs->{bind}, $ident, $select, $condition, $order);
+ $ident = $self->_build_from($ident) if ref $ident;
+ my @args = ('select', $attrs->{bind}, $ident, $select, $condition, $order);
+ if ($self->sql_maker->_default_limit_syntax eq "GenericSubQ") {
+ $attrs->{software_limit} = 1;
+ } else {
+ push @args, $attrs->{rows}, $attrs->{offset};
+ }
+ return $self->_execute(@args);
+}
+
+sub select {
+ my $self = shift;
+ my ($ident, $select, $condition, $attrs) = @_;
+ my ($rv, $sth, @bind) = $self->_select(@_);
return $self->cursor->new($sth, \@bind, $attrs);
}
+sub select_single {
+ my $self = shift;
+ my ($rv, $sth, @bind) = $self->_select(@_);
+ return $sth->fetchrow_array;
+}
+
sub sth {
shift->dbh->prepare(@_);
}
=head1 AUTHORS
-Matt S. Trout <perl-stuff@trout.me.uk>
+Matt S. Trout <mst@shadowcatsystems.co.uk>
+
+Andy Grundman <andy@hybridized.org>
=head1 LICENSE