Working HAVING, DBD::SQLite returns duff data so tests don't pass yet

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI.pm

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 4a72a95..492cc91 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -17,8 +17,10 @@ use base qw/SQL::Abstract::Limit/;
 sub select {
   my ($self, $table, $fields, $where, $order, @rest) = @_;
   @rest = (-1) unless defined $rest[0];
-  $self->SUPER::select($table, $self->_recurse_fields($fields), 
-                         $where, $order, @rest);
+  local $self->{having_bind} = [];
+  my ($sql, @ret) = $self->SUPER::select($table,
+                      $self->_recurse_fields($fields), $where, $order, @rest);
+  return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
 }
 
 sub _emulate_limit {
@@ -49,11 +51,18 @@ sub _recurse_fields {
 sub _order_by {
   my $self = shift;
   my $ret = '';
+  my @extra;
   if (ref $_[0] eq 'HASH') {
     if (defined $_[0]->{group_by}) {
       $ret = $self->_sqlcase(' group by ')
                .$self->_recurse_fields($_[0]->{group_by});
     }
+    if (defined $_[0]->{having}) {
+      my $frag;
+      ($frag, @extra) = $self->_recurse_where($_[0]->{having});
+      push(@{$self->{having_bind}}, @extra);
+      $ret .= $self->_sqlcase(' having ').$frag;
+    }
     if (defined $_[0]->{order_by}) {
       $ret .= $self->SUPER::_order_by($_[0]->{order_by});
     }
@@ -63,6 +72,12 @@ sub _order_by {
   return $ret;
 }
 
+sub _order_directions {
+  my ($self, $order) = @_;
+  $order = $order->{order_by} if ref $order eq 'HASH';
+  return $self->SUPER::_order_directions($order);
+}
+
 sub _table {
   my ($self, $from) = @_;
   if (ref $from eq 'ARRAY') {
@@ -134,6 +149,14 @@ sub _quote {
   return $self->SUPER::_quote($label);
 }
 
+sub _RowNum {
+   my $self = shift;
+   my $c;
+   $_[0] =~ s/SELECT (.*?) FROM/
+     'SELECT '.join(', ', map { $_.' AS col'.++$c } split(', ', $1)).' FROM'/e;
+   $self->SUPER::_RowNum(@_);
+}
+
 # Accessor for setting limit dialect. This is useful
 # for JDBC-bridge among others where the remote SQL-dialect cannot
 # be determined by the name of the driver alone.
@@ -159,7 +182,8 @@ use base qw/DBIx::Class/;
 __PACKAGE__->load_components(qw/AccessorGroup/);
 
 __PACKAGE__->mk_group_accessors('simple' =>
-  qw/connect_info _dbh _sql_maker debug debugfh cursor on_connect_do transaction_depth/);
+  qw/connect_info _dbh _sql_maker _connection_pid debug debugfh cursor
+     on_connect_do transaction_depth/);
 
 sub new {
   my $new = bless({}, ref $_[0] || $_[0]);
@@ -248,6 +272,8 @@ sub ensure_connected {
 sub dbh {
   my ($self) = @_;
 
+  $self->_dbh(undef)
+    if $self->_connection_pid && $self->_connection_pid != $$;
   $self->ensure_connected;
   return $self->_dbh;
 }
@@ -264,16 +290,34 @@ sub _populate_dbh {
   my ($self) = @_;
   my @info = @{$self->connect_info || []};
   $self->_dbh($self->_connect(@info));
-
+  my $driver = $self->_dbh->{Driver}->{Name};
+  eval "require DBIx::Class::Storage::DBI::${driver}";
+  unless ($@) {
+    bless $self, "DBIx::Class::Storage::DBI::${driver}";
+  }
   # if on-connect sql statements are given execute them
   foreach my $sql_statement (@{$self->on_connect_do || []}) {
     $self->_dbh->do($sql_statement);
   }
+
+  $self->_connection_pid($$);
 }
 
 sub _connect {
   my ($self, @info) = @_;
-  return DBI->connect(@info);
+
+  if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) {
+      my $old_connect_via = $DBI::connect_via;
+      $DBI::connect_via = 'connect';
+      my $dbh = DBI->connect(@info);
+      $DBI::connect_via = $old_connect_via;
+      return $dbh;
+  }
+
+  my $dbh = DBI->connect(@info);
+  croak "DBI Connection failed: $DBI::errstr"
+      unless $dbh;
+  $dbh;
 }
 
 =head2 txn_begin
@@ -328,6 +372,7 @@ sub _execute {
       $self->debugfh->print("$sql: @debug_bind\n");
   }
   my $sth = $self->sth($sql,$op);
+  croak "no sth generated via sql: $sql" unless $sth;
   @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
   my $rv;
   if ($sth) {  
@@ -359,8 +404,9 @@ sub _select {
   if (ref $condition eq 'SCALAR') {
     $order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
   }
-  if (exists $attrs->{group_by}) {
+  if (exists $attrs->{group_by} || $attrs->{having}) {
     $order = { group_by => $attrs->{group_by},
+               having => $attrs->{having},
                ($order ? (order_by => $order) : ()) };
   }
   my @args = ('select', $attrs->{bind}, $ident, $select, $condition, $order);
@@ -425,6 +471,15 @@ sub columns_info_for {
     return \%result;
 }
 
+sub last_insert_id {
+  my ($self, $row) = @_;
+    
+  return $self->dbh->func('last_insert_rowid');
+
+}
+
+
+
 sub DESTROY { shift->disconnect }
 
 1;