Merge 'DBIx-Class-current' into 'resultset-new-refactor'
Matt S Trout [Tue, 23 May 2006 20:21:54 +0000 (20:21 +0000)]
r5826@cain (orig r1579):  semifor | 2006-05-08 17:41:54 +0000
Generalized the loading of subclasses for specfic ODBC backends.

r5829@cain (orig r1582):  semifor | 2006-05-09 00:02:54 +0000
- Factored out sql_maker arguments so they can be customized by derived
::Storage::DBI::* modules.
- Customized sql_maker arguments for DB2/400 over ODBC.

r5837@cain (orig r1590):  matthewt | 2006-05-09 13:45:52 +0000
 r5828@cain (orig r1581):  matthewt | 2006-05-08 23:03:00 +0000
 couple bugfixes

r5840@cain (orig r1593):  matthewt | 2006-05-09 18:03:41 +0000
 r5838@cain (orig r1591):  bluefeet | 2006-05-09 15:00:56 +0000
 Comment to DBIX_CLASS_STORAGE_DBI_DEBUG stating that it is read on storage creation.

r5870@cain (orig r1595):  bluefeet | 2006-05-09 22:02:44 +0000
Add search_rs to ResultSet and a new {$rel}_rs accessor to has_many.
r5871@cain (orig r1596):  bluefeet | 2006-05-09 22:17:38 +0000
Fixes to _rs related docs.
r5872@cain (orig r1597):  semifor | 2006-05-09 23:21:39 +0000
Test case for DB2/400 over ODBC.

r5873@cain (orig r1598):  semifor | 2006-05-09 23:37:16 +0000
Test case for DB2/400 over ODBC.

r5876@cain (orig r1601):  dwc | 2006-05-10 15:02:14 +0000
Row::update encapsulates this when passed a hashref; no point in duplication
r5877@cain (orig r1602):  dwc | 2006-05-10 15:55:35 +0000
Revert previous bugfix; will apply to trunk
r5879@cain (orig r1604):  dwc | 2006-05-10 16:01:46 +0000
 r8956@fortuna (orig r1603):  dwc | 2006-05-10 12:00:11 -0400
 Row::update encapsulates this when passed a hashref; using set_columns bypasses deflation

r5880@cain (orig r1605):  dwc | 2006-05-10 20:46:16 +0000
- Fix error message for bad find usage
- Restore backwards compatibility for e.g. $rs->find(id => $val)
- Add a test for the $rs->find(id => $val) backwards compatibility
r5881@cain (orig r1606):  bluefeet | 2006-05-11 01:49:58 +0000
dbicadmin now works when not specifying the where clause.
r5906@cain (orig r1619):  matthewt | 2006-05-12 14:16:48 +0000
 r5900@cain (orig r1613):  jguenther | 2006-05-11 19:20:59 +0000
 Added a couple examples to the cookbook
 r5901@cain (orig r1614):  jguenther | 2006-05-11 21:53:25 +0000
 Fixed cookbook example to actually work

 r5902@cain (orig r1615):  matthewt | 2006-05-12 00:56:54 +0000
 performance fix for cascade_update
 r5903@cain (orig r1616):  matthewt | 2006-05-12 01:04:37 +0000
 fixup to gen-schema.pl
 r5904@cain (orig r1617):  matthewt | 2006-05-12 02:17:18 +0000
 fixup for stringify that can be false in find_or_create_related

r5919@cain (orig r1620):  bluefeet | 2006-05-12 20:49:30 +0000
Testing commit.

r5923@cain (orig r1624):  matthewt | 2006-05-14 18:27:01 +0000
 r5922@cain (orig r1623):  matthewt | 2006-05-14 18:25:56 +0000
 tweaked might_have test for -current

r5924@cain (orig r1625):  castaway | 2006-05-14 19:11:48 +0000
Add foreign key constraint for new bookmark table

r5925@cain (orig r1626):  matthewt | 2006-05-15 01:33:12 +0000
don't ask
r5926@cain (orig r1627):  matthewt | 2006-05-15 01:34:00 +0000
don't ask
r5980@cain (orig r1628):  matthewt | 2006-05-15 04:19:23 +0000
dumped options from Build.PL
r8655@cain (orig r1629):  gphat | 2006-05-15 17:46:01 +0000
Add profiling support

r8695@cain (orig r1663):  matthewt | 2006-05-18 13:19:02 +0000
 r8675@cain (orig r1649):  castaway | 2006-05-17 09:28:27 +0000
 Documentation updates

 r8676@cain (orig r1650):  zarquon | 2006-05-17 09:49:18 +0000
 optimised last_insert_id example for searching
 r8691@cain (orig r1659):  castaway | 2006-05-18 09:48:30 +0000
 Add pod for params of inflate/deflate coderefs

r8709@cain (orig r1677):  tomk | 2006-05-18 17:13:14 +0000
Moved UUIDColumns from DBIX-Class-current into it's own dist in the trunk
r8710@cain (orig r1678):  matthewt | 2006-05-18 17:36:48 +0000
Moved PK::Auto into core
r8749@cain (orig r1702):  castaway | 2006-05-19 20:26:38 +0000
zbys Postgres casecheck patch

r8752@cain (orig r1703):  jguenther | 2006-05-19 20:50:55 +0000
added ensure_class_loaded method to Componentized, which should fix problems with nonexistent classes referenced in relationships going undetected
r8753@cain (orig r1704):  jguenther | 2006-05-19 20:56:32 +0000
removed DBICTest::Schema::Casecheck until someone adds it
r8764@cain (orig r1715):  matthewt | 2006-05-20 00:34:58 +0000
 r8698@cain (orig r1666):  tomk | 2006-05-18 15:56:54 +0000
 Moved UUIDColumns.pm over from main DBIx::Class dist

 r8699@cain (orig r1667):  tomk | 2006-05-18 15:59:52 +0000
 Moved UUIDMaker.pm over from main DBIx::Class dist

 r8707@cain (orig r1675):  tomk | 2006-05-18 16:49:41 +0000
 Undoing changes commited in revisions 1664-1671... Sorry for the fuck up
 r8718@cain (orig r1681):  jguenther | 2006-05-18 18:32:06 +0000
 added bind information to exception thrown from DBIx::Class::Storage::DBI::_execute()
 r8731@cain (orig r1684):  jguenther | 2006-05-18 21:55:45 +0000
 removed another couple extraneous $self->dbh calls
 r8732@cain (orig r1685):  jguenther | 2006-05-18 22:11:20 +0000
 fixed small error in the SYNOPSIS of ResultSetManager.pm
 r8733@cain (orig r1686):  jguenther | 2006-05-18 22:34:31 +0000
 fixed an out-of-date limitation for has_many prefetch mentioned in Cookbook.pm
 r8741@cain (orig r1694):  castaway | 2006-05-19 12:42:20 +0000
 Update VERSION

 r8742@cain (orig r1695):  castaway | 2006-05-19 13:03:20 +0000
 Oops, fix bookmark thingy here too

 r8743@cain (orig r1696):  castaway | 2006-05-19 13:12:22 +0000
 .. And correct the number of tests

r8767@cain (orig r1718):  matthewt | 2006-05-20 00:53:52 +0000
 r1656@cain (orig r1519):  matthewt | 2006-04-26 03:19:25 +0000
 Added InflateColumn::DateTime component

r8768@cain (orig r1719):  matthewt | 2006-05-20 00:54:25 +0000
 r8669@cain (orig r1643):  matthewt | 2006-05-17 00:22:06 +0000
 Missing stuff for DateTime branch

r8769@cain (orig r1720):  matthewt | 2006-05-20 00:54:29 +0000

r8770@cain (orig r1721):  matthewt | 2006-05-20 00:54:33 +0000

r8771@cain (orig r1722):  matthewt | 2006-05-20 00:54:37 +0000
 r8762@cain (orig r1713):  matthewt | 2006-05-20 00:33:14 +0000
 added datetime parser types for the dbs I can find them for

r8772@cain (orig r1723):  matthewt | 2006-05-20 00:54:41 +0000
 r8763@cain (orig r1714):  matthewt | 2006-05-20 00:34:39 +0000
 added datetime parser for MSSQL (ta LTJake)

r8773@cain (orig r1724):  matthewt | 2006-05-20 00:54:44 +0000

r8774@cain (orig r1725):  matthewt | 2006-05-20 01:14:38 +0000
futz changes, fix populate. I'm a retard.
r8779@cain (orig r1730):  claco | 2006-05-20 20:40:55 +0000
Added delete_related tests to verify it only deletes related records
r8841@cain (orig r1762):  matthewt | 2006-05-23 17:42:15 +0000
Sodding three-value for conditions
r8842@cain (orig r1763):  semifor | 2006-05-23 18:17:16 +0000
Just the column name, please.

lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/Storage/DBI.pm
lib/DBIx/Class/Storage/DBI/ODBC400.pm [new file with mode: 0644]
t/basicrels/30join_torture.t [new file with mode: 0644]
t/helperrels/30join_torture.t [new file with mode: 0644]
t/lib/sqlite.sql
t/run/01core.tl
t/run/16joins.tl
t/run/30join_torture.tl [new file with mode: 0644]

index 8fc894d..f57c913 100644 (file)
@@ -8,6 +8,7 @@ use overload
         fallback => 1;
 use Data::Page;
 use Storable;
+use Data::Dumper;
 use Scalar::Util qw/weaken/;
 
 use DBIx::Class::ResultSetColumn;
@@ -86,68 +87,6 @@ sub new {
   
   my ($source, $attrs) = @_;
   weaken $source;
-  $attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
-  #use Data::Dumper; warn Dumper($attrs);
-  my $alias = ($attrs->{alias} ||= 'me');
-  
-  $attrs->{columns} ||= delete $attrs->{cols} if $attrs->{cols};
-  delete $attrs->{as} if $attrs->{columns};
-  $attrs->{columns} ||= [ $source->columns ] unless $attrs->{select};
-  $attrs->{select} = [
-    map { m/\./ ? $_ : "${alias}.$_" } @{delete $attrs->{columns}}
-  ] if $attrs->{columns};
-  $attrs->{as} ||= [
-    map { m/^\Q$alias.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}}
-  ];
-  if (my $include = delete $attrs->{include_columns}) {
-    push(@{$attrs->{select}}, @$include);
-    push(@{$attrs->{as}}, map { m/([^.]+)$/; $1; } @$include);
-  }
-  #use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/});
-
-  $attrs->{from} ||= [ { $alias => $source->from } ];
-  $attrs->{seen_join} ||= {};
-  my %seen;
-  if (my $join = delete $attrs->{join}) {
-    foreach my $j (ref $join eq 'ARRAY' ? @$join : ($join)) {
-      if (ref $j eq 'HASH') {
-        $seen{$_} = 1 foreach keys %$j;
-      } else {
-        $seen{$j} = 1;
-      }
-    }
-    push(@{$attrs->{from}}, $source->resolve_join(
-      $join, $attrs->{alias}, $attrs->{seen_join})
-    );
-  }
-  
-  $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
-  $attrs->{order_by} = [ $attrs->{order_by} ] if
-    $attrs->{order_by} and !ref($attrs->{order_by});
-  $attrs->{order_by} ||= [];
-
-  my $collapse = $attrs->{collapse} || {};
-  if (my $prefetch = delete $attrs->{prefetch}) {
-    my @pre_order;
-    foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) {
-      if ( ref $p eq 'HASH' ) {
-        foreach my $key (keys %$p) {
-          push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
-            unless $seen{$key};
-        }
-      } else {
-        push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
-            unless $seen{$p};
-      }
-      my @prefetch = $source->resolve_prefetch(
-           $p, $attrs->{alias}, {}, \@pre_order, $collapse);
-      push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
-      push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
-    }
-    push(@{$attrs->{order_by}}, @pre_order);
-  }
-  $attrs->{collapse} = $collapse;
-#  use Data::Dumper; warn Dumper($collapse) if keys %{$collapse};
 
   if ($attrs->{page}) {
     $attrs->{rows} ||= 10;
@@ -155,12 +94,14 @@ sub new {
     $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
   }
 
+  $attrs->{alias} ||= 'me';
+
   bless {
     result_source => $source,
     result_class => $attrs->{result_class} || $source->result_class,
     cond => $attrs->{where},
-    from => $attrs->{from},
-    collapse => $collapse,
+#    from => $attrs->{from},
+#    collapse => $collapse,
     count => undef,
     page => delete $attrs->{page},
     pager => undef,
@@ -218,10 +159,29 @@ always return a resultset, even in list context.
 sub search_rs {
   my $self = shift;
 
-  my $attrs = { %{$self->{attrs}} };
-  my $having = delete $attrs->{having};
-  $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH';
+  my $our_attrs = { %{$self->{attrs}} };
+  my $having = delete $our_attrs->{having};
+  my $attrs = {};
+  $attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
+  
+  # merge new attrs into old
+  foreach my $key (qw/join prefetch/) {
+    next unless (exists $attrs->{$key});
+    if (exists $our_attrs->{$key}) {
+      $our_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
+    } else {
+      $our_attrs->{$key} = $attrs->{$key};
+    }
+    delete $attrs->{$key};
+  }
+
+  if (exists $our_attrs->{prefetch}) {
+      $our_attrs->{join} = $self->_merge_attr($our_attrs->{join}, $our_attrs->{prefetch}, 1);
+  }
 
+  my $new_attrs = { %{$our_attrs}, %{$attrs} };
+
+  # merge new where and having into old
   my $where = (@_
                 ? ((@_ == 1 || ref $_[0] eq "HASH")
                     ? shift
@@ -231,22 +191,23 @@ sub search_rs {
                         : {@_}))
                 : undef());
   if (defined $where) {
-    $attrs->{where} = (defined $attrs->{where}
+    $new_attrs->{where} = (defined $new_attrs->{where}
               ? { '-and' =>
                   [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
-                      $where, $attrs->{where} ] }
+                      $where, $new_attrs->{where} ] }
               : $where);
   }
 
   if (defined $having) {
-    $attrs->{having} = (defined $attrs->{having}
+    $new_attrs->{having} = (defined $new_attrs->{having}
               ? { '-and' =>
                   [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
-                      $having, $attrs->{having} ] }
+                      $having, $new_attrs->{having} ] }
               : $having);
   }
 
-  my $rs = (ref $self)->new($self->result_source, $attrs);
+  my $rs = (ref $self)->new($self->result_source, $new_attrs);
+  $rs->{_parent_rs} = $self->{_parent_rs} if ($self->{_parent_rs}); #XXX - hack to pass through parent of related resultsets
 
   unless (@_) { # no search, effectively just a clone
     my $rows = $self->get_cache;
@@ -379,10 +340,12 @@ sub find {
   # Run the query
   if (keys %$attrs) {
     my $rs = $self->search($query, $attrs);
-    return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
+    $rs->_resolve;
+    return keys %{$rs->{_attrs}->{collapse}} ? $rs->next : $rs->single;
   }
   else {
-    return keys %{$self->{collapse}}
+    $self->_resolve;  
+    return (keys %{$self->{_attrs}->{collapse}})
       ? $self->search($query)->next
       : $self->single($query);
   }
@@ -443,9 +406,11 @@ L<DBIx::Class::Cursor> for more information.
 
 sub cursor {
   my ($self) = @_;
-  my $attrs = { %{$self->{attrs}} };
+
+  $self->_resolve;
+  my $attrs = { %{$self->{_attrs}} };
   return $self->{cursor}
-    ||= $self->result_source->storage->select($self->{from}, $attrs->{select},
+    ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select},
           $attrs->{where},$attrs);
 }
 
@@ -472,7 +437,8 @@ method; if you need to add extra joins or similar call ->search and then
 
 sub single {
   my ($self, $where) = @_;
-  my $attrs = { %{$self->{attrs}} };
+  $self->_resolve;
+  my $attrs = { %{$self->{_attrs}} };
   if ($where) {
     if (defined $attrs->{where}) {
       $attrs->{where} = {
@@ -484,8 +450,9 @@ sub single {
       $attrs->{where} = $where;
     }
   }
+
   my @data = $self->result_source->storage->select_single(
-          $self->{from}, $attrs->{select},
+          $attrs->{from}, $attrs->{select},
           $attrs->{where},$attrs);
   return (@data ? $self->_construct_object(@data) : ());
 }
@@ -610,27 +577,152 @@ sub next {
                @{delete $self->{stashed_row}} :
                $self->cursor->next
   );
-#  warn Dumper(\@row); use Data::Dumper;
   return unless (@row);
   return $self->_construct_object(@row);
 }
 
+sub _resolve {
+  my $self = shift;
+
+  return if(exists $self->{_attrs}); #return if _resolve has already been called
+
+  my $attrs = $self->{attrs};  
+  my $source = ($self->{_parent_rs}) ? $self->{_parent_rs} : $self->{result_source};
+
+  # XXX - lose storable dclone
+  my $record_filter = delete $attrs->{record_filter} if (defined $attrs->{record_filter});
+  $attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
+  $attrs->{record_filter} = $record_filter if ($record_filter);
+  $self->{attrs}->{record_filter} = $record_filter if ($record_filter);
+
+  my $alias = $attrs->{alias};
+  $attrs->{columns} ||= delete $attrs->{cols} if $attrs->{cols};
+  delete $attrs->{as} if $attrs->{columns};
+  $attrs->{columns} ||= [ $self->{result_source}->columns ] unless $attrs->{select};
+  my $select_alias = ($self->{_parent_rs}) ? $self->{attrs}->{_live_join} : $alias;
+  $attrs->{select} = [
+                     map { m/\./ ? $_ : "${select_alias}.$_" } @{delete $attrs->{columns}}
+                     ] if $attrs->{columns};
+  $attrs->{as} ||= [
+                   map { m/^\Q$alias.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}}
+                   ];
+  if (my $include = delete $attrs->{include_columns}) {
+      push(@{$attrs->{select}}, @$include);
+      push(@{$attrs->{as}}, map { m/([^.]+)$/; $1; } @$include);
+  }
+
+  $attrs->{from} ||= [ { $alias => $source->from } ];
+  $attrs->{seen_join} ||= {};
+  my %seen;
+  if (my $join = delete $attrs->{join}) {
+      foreach my $j (ref $join eq 'ARRAY' ? @$join : ($join)) {
+         if (ref $j eq 'HASH') {
+             $seen{$_} = 1 foreach keys %$j;
+         } else {
+             $seen{$j} = 1;
+         }
+      }
+
+      push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}, $attrs->{seen_join}));
+  }
+  $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
+  $attrs->{order_by} = [ $attrs->{order_by} ] if
+      $attrs->{order_by} and !ref($attrs->{order_by});
+  $attrs->{order_by} ||= [];
+  
+  my $collapse = $attrs->{collapse} || {};
+  if (my $prefetch = delete $attrs->{prefetch}) {
+      my @pre_order;
+      foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) {
+         if ( ref $p eq 'HASH' ) {
+             foreach my $key (keys %$p) {
+                 push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
+                     unless $seen{$key};
+             }
+         } else {
+             push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
+                 unless $seen{$p};
+         }
+         my @prefetch = $source->resolve_prefetch(
+                                                  $p, $attrs->{alias}, {}, \@pre_order, $collapse);
+         push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
+         push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
+      }
+      push(@{$attrs->{order_by}}, @pre_order);
+  }
+  $attrs->{collapse} = $collapse;
+  $self->{_attrs} = $attrs;
+}
+
+sub _merge_attr {
+  my ($self, $a, $b, $is_prefetch) = @_;
+    
+  return $b unless $a;
+  if (ref $b eq 'HASH' && ref $a eq 'HASH') {
+               foreach my $key (keys %{$b}) {
+                       if (exists $a->{$key}) {
+             $a->{$key} = $self->_merge_attr($a->{$key}, $b->{$key}, $is_prefetch);
+                       } else {
+             $a->{$key} = delete $b->{$key};
+                       }
+               }
+               return $a;
+  } else {
+               $a = [$a] unless (ref $a eq 'ARRAY');
+               $b = [$b] unless (ref $b eq 'ARRAY');
+
+               my $hash = {};
+               my $array = [];      
+               foreach ($a, $b) {
+                       foreach my $element (@{$_}) {
+             if (ref $element eq 'HASH') {
+                                       $hash = $self->_merge_attr($hash, $element, $is_prefetch);
+             } elsif (ref $element eq 'ARRAY') {
+                                       $array = [@{$array}, @{$element}];
+             } else {  
+                                       if (($b == $_) && $is_prefetch) {
+                                               $self->_merge_array($array, $element, $is_prefetch);
+                                       } else {
+                                               push(@{$array}, $element);
+                                       }
+             }
+                       }
+               }
+
+               if ((keys %{$hash}) && (scalar(@{$array} > 0))) {
+                       return [$hash, @{$array}];
+               } else {        
+                       return (keys %{$hash}) ? $hash : $array;
+               }
+  }
+}
+
+sub _merge_array {
+       my ($self, $a, $b) = @_;
+       $b = [$b] unless (ref $b eq 'ARRAY');
+       # add elements from @{$b} to @{$a} which aren't already in @{$a}
+       foreach my $b_element (@{$b}) {
+               push(@{$a}, $b_element) unless grep {$b_element eq $_} @{$a};
+       }
+}
+
 sub _construct_object {
   my ($self, @row) = @_;
-  my @as = @{ $self->{attrs}{as} };
-  
+  my @as = @{ $self->{_attrs}{as} };
+
   my $info = $self->_collapse_result(\@as, \@row);
-  
   my $new = $self->result_class->inflate_result($self->result_source, @$info);
-  
-  $new = $self->{attrs}{record_filter}->($new)
-    if exists $self->{attrs}{record_filter};
+  $new = $self->{_attrs}{record_filter}->($new)
+    if exists $self->{_attrs}{record_filter};
   return $new;
 }
 
 sub _collapse_result {
   my ($self, $as, $row, $prefix) = @_;
 
+  my $live_join = $self->{attrs}->{_live_join} ||="";
   my %const;
 
   my @copy = @$row;
@@ -650,7 +742,7 @@ sub _collapse_result {
 
   my $info = [ {}, {} ];
   foreach my $key (keys %const) {
-    if (length $key) {
+    if (length $key && $key ne $live_join) {
       my $target = $info;
       my @parts = split(/\./, $key);
       foreach my $p (@parts) {
@@ -666,9 +758,9 @@ sub _collapse_result {
   if (defined $prefix) {
     @collapse = map {
         m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
-    } keys %{$self->{collapse}}
+    } keys %{$self->{_attrs}->{collapse}}
   } else {
-    @collapse = keys %{$self->{collapse}};
+    @collapse = keys %{$self->{_attrs}->{collapse}};
   };
 
   if (@collapse) {
@@ -678,7 +770,7 @@ sub _collapse_result {
       $target = $target->[1]->{$p} ||= [];
     }
     my $c_prefix = (defined($prefix) ? "${prefix}.${c}" : $c);
-    my @co_key = @{$self->{collapse}{$c_prefix}};
+    my @co_key = @{$self->{_attrs}->{collapse}{$c_prefix}};
     my %co_check = map { ($_, $target->[0]->{$_}); } @co_key;
     my $tree = $self->_collapse_result($as, $row, $c_prefix);
     my (@final, @raw);
@@ -691,10 +783,9 @@ sub _collapse_result {
       $row = $self->{stashed_row} = \@raw;
       $tree = $self->_collapse_result($as, $row, $c_prefix);
     }
-    @$target = (@final ? @final : [ {}, {} ]);
+    @$target = (@final ? @final : [ {}, {} ]); 
       # single empty result to indicate an empty prefetched has_many
   }
-
   return $info;
 }
 
@@ -753,8 +844,10 @@ sub count {
 sub _count { # Separated out so pager can get the full count
   my $self = shift;
   my $select = { count => '*' };
-  my $attrs = { %{ $self->{attrs} } };
-  if (my $group_by = delete $attrs->{group_by}) {
+  
+  $self->_resolve;
+  my $attrs = { %{ $self->{_attrs} } };
+  if ($attrs->{distinct} && (my $group_by = $attrs->{group_by} || $attrs->{select})) {
     delete $attrs->{having};
     my @distinct = (ref $group_by ?  @$group_by : ($group_by));
     # todo: try CONCAT for multi-column pk
@@ -769,7 +862,6 @@ sub _count { # Separated out so pager can get the full count
     }
 
     $select = { count => { distinct => \@distinct } };
-    #use Data::Dumper; die Dumper $select;
   }
 
   $attrs->{select} = $select;
@@ -777,7 +869,6 @@ sub _count { # Separated out so pager can get the full count
 
   # offset, order by and page are not needed to count. record_filter is cdbi
   delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
-        
   my ($count) = (ref $self)->new($self->result_source, $attrs)->cursor->next;
   return $count;
 }
@@ -820,12 +911,14 @@ sub all {
 
   my @obj;
 
-  if (keys %{$self->{collapse}}) {
+  # TODO: don't call resolve here
+  $self->_resolve;
+  if (keys %{$self->{_attrs}->{collapse}}) {
+#  if ($self->{attrs}->{prefetch}) {
       # Using $self->cursor->all is really just an optimisation.
       # If we're collapsing has_many prefetches it probably makes
       # very little difference, and this is cleaner than hacking
       # _construct_object to survive the approach
-    $self->cursor->reset;
     my @row = $self->cursor->next;
     while (@row) {
       push(@obj, $self->_construct_object(@row));
@@ -857,6 +950,8 @@ Resets the resultset's cursor, so you can iterate through the elements again.
 
 sub reset {
   my ($self) = @_;
+  delete $self->{_attrs} if (exists $self->{_attrs});
+
   $self->{all_cache_position} = 0;
   $self->cursor->reset;
   return $self;
@@ -1312,7 +1407,7 @@ than re-querying the database even if the cache attr is not set.
 sub set_cache {
   my ( $self, $data ) = @_;
   $self->throw_exception("set_cache requires an arrayref")
-    if defined($data) && (ref $data ne 'ARRAY');
+      if defined($data) && (ref $data ne 'ARRAY');
   $self->{all_cache} = $data;
 }
 
@@ -1352,28 +1447,28 @@ Returns a related resultset for the supplied relationship name.
 
 sub related_resultset {
   my ( $self, $rel ) = @_;
+
   $self->{related_resultsets} ||= {};
   return $self->{related_resultsets}{$rel} ||= do {
-      #warn "fetching related resultset for rel '$rel'";
+      #warn "fetching related resultset for rel '$rel' " . $self->result_source->{name};
       my $rel_obj = $self->result_source->relationship_info($rel);
       $self->throw_exception(
         "search_related: result source '" . $self->result_source->name .
         "' has no such relationship ${rel}")
         unless $rel_obj; #die Dumper $self->{attrs};
 
-      my $rs = $self->search(undef, { join => $rel });
-      my $alias = defined $rs->{attrs}{seen_join}{$rel}
-                    && $rs->{attrs}{seen_join}{$rel} > 1
-                  ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
-                  : $rel;
-
-      $self->result_source->schema->resultset($rel_obj->{class}
+      my $rs = $self->result_source->schema->resultset($rel_obj->{class}
            )->search( undef,
-             { %{$rs->{attrs}},
-               alias => $alias,
+             { %{$self->{attrs}},
                select => undef,
-               as => undef }
+               as => undef,
+              join => $rel,
+              _live_join => $rel }
            );
+
+      # keep reference of the original resultset
+      $rs->{_parent_rs} = $self->result_source;
+      return $rs;
   };
 }
 
index 9405288..376e48c 100644 (file)
@@ -21,8 +21,6 @@ sub select {
   my ($self, $table, $fields, $where, $order, @rest) = @_;
   $table = $self->_quote($table) unless ref($table);
   @rest = (-1) unless defined $rest[0];
-  die "LIMIT 0 Does Not Compute" if $rest[0] == 0;
-    # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
   local $self->{having_bind} = [];
   my ($sql, @ret) = $self->SUPER::select(
     $table, $self->_recurse_fields($fields), $where, $order, @rest
@@ -432,7 +430,11 @@ sub _populate_dbh {
   my ($self) = @_;
   my @info = @{$self->_connect_info || []};
   $self->_dbh($self->_connect(@info));
-  my $driver = $self->_dbh->{Driver}->{Name};
+  my $dbh = $self->_dbh;
+  my $driver = $dbh->{Driver}->{Name};
+  if ( $driver eq 'ODBC' and $dbh->get_info(17) =~ m{^DB2/400} ) {
+    $driver = 'ODBC400';
+  }
   eval "require DBIx::Class::Storage::DBI::${driver}";
   unless ($@) {
     bless $self, "DBIx::Class::Storage::DBI::${driver}";
@@ -637,8 +639,6 @@ sub _select {
       $self->sql_maker->_default_limit_syntax eq "GenericSubQ") {
         $attrs->{software_limit} = 1;
   } else {
-    $self->throw_exception("rows attribute must be positive if present")
-      if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
     push @args, $attrs->{rows}, $attrs->{offset};
   }
   return $self->_execute(@args);
diff --git a/lib/DBIx/Class/Storage/DBI/ODBC400.pm b/lib/DBIx/Class/Storage/DBI/ODBC400.pm
new file mode 100644 (file)
index 0000000..7fdd1f8
--- /dev/null
@@ -0,0 +1,55 @@
+package DBIx::Class::Storage::DBI::ODBC400;
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+sub last_insert_id
+{
+    my ($self) = @_;
+
+    my $dbh = $self->_dbh;
+
+    # get the schema/table separator:
+    #    '.' when SQL naming is active
+    #    '/' when system naming is active
+    my $sep = $dbh->get_info(41);
+    my $sth = $dbh->prepare_cached(
+        "SELECT IDENTITY_VAL_LOCAL() FROM SYSIBM${sep}SYSDUMMY1", {}, 3);
+    $sth->execute();
+
+    my @res = $sth->fetchrow_array();
+
+    return @res ? $res[0] : undef;
+}
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ODBC400 - Automatic primary key class for DB2/400
+over ODBC
+
+=head1 SYNOPSIS
+
+  # In your table classes
+  __PACKAGE__->load_components(qw/PK::Auto Core/);
+  __PACKAGE__->set_primary_key('id');
+
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for DB2/400 over ODBC.
+
+
+=head1 AUTHORS
+
+Marc Mims C<< <marc@questright.com> >>
+
+Based on DBIx::Class::Storage::DBI::DB2 by Jess Robinson.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
diff --git a/t/basicrels/30join_torture.t b/t/basicrels/30join_torture.t
new file mode 100644 (file)
index 0000000..6bc0ca5
--- /dev/null
@@ -0,0 +1,7 @@
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/30join_torture.tl";
+run_tests(DBICTest->schema);
diff --git a/t/helperrels/30join_torture.t b/t/helperrels/30join_torture.t
new file mode 100644 (file)
index 0000000..1e85aeb
--- /dev/null
@@ -0,0 +1,7 @@
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/30join_torture.tl";
+run_tests(DBICTest->schema);
index 6a63ce7..aa0d08f 100644 (file)
@@ -105,6 +105,15 @@ CREATE TABLE self_ref (
 );
 
 --
+-- Table: treelike
+--
+CREATE TABLE treelike (
+  id INTEGER PRIMARY KEY NOT NULL,
+  parent integer NOT NULL,
+  name varchar(100) NOT NULL
+);
+
+--
 -- Table: tags
 --
 CREATE TABLE tags (
index 05e4dd3..3a3b2fd 100644 (file)
@@ -1,7 +1,7 @@
 sub run_tests {
 my $schema = shift;
 
-plan tests => 58;
+plan tests => 59;
 
 # figure out if we've got a version of sqlite that is older than 3.2.6, in
 # which case COUNT(DISTINCT()) doesn't work
@@ -32,6 +32,14 @@ is($art->get_column("name"), 'We Are In Rehab', 'And via get_column');
 
 ok($art->update, 'Update run');
 
+my $record_jp = $schema->resultset("Artist")->search(undef, { join => 'cds' })->search(undef, { prefetch => 'cds' })->next;
+
+ok($record_jp, "prefetch on same rel okay");
+
+my $record_fn = $schema->resultset("Artist")->search(undef, { join => 'cds' })->search({'cds.cdid' => '1'}, {join => 'artist_undirected_maps'})->next;
+
+ok($record_fn, "funny join is okay");
+
 @art = $schema->resultset("Artist")->search({ name => 'We Are In Rehab' });
 
 cmp_ok(@art, '==', 1, "Changed artist returned by search");
index 15603aa..c83aa7c 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     eval "use DBD::SQLite";
     plan $@
         ? ( skip_all => 'needs DBD::SQLite for testing' )
-        : ( tests => 44 );
+        : ( tests => 42 );
 }
 
 # figure out if we've got a version of sqlite that is older than 3.2.6, in
@@ -101,10 +101,6 @@ $rs = $schema->resultset("CD")->search(
 );
 cmp_ok( scalar $rs->all, '==', scalar $rs->slice(0, $rs->count - 1), 'slice() with join has same count as all()' );
 
-eval { $rs->search(undef, { rows => 0, offset => 3 })->all; };
-
-ok($@, "rows => 0 errors: $@");
-
 $rs = $schema->resultset("Artist")->search(
         { 'liner_notes.notes' => 'Kill Yourself!' },
         { join => { 'cds' => 'liner_notes' } });
@@ -277,25 +273,6 @@ $schema->storage->debug(0);
 
 cmp_ok($queries, '==', 1, 'Only one query run');
 
-# has_many resulting in an additional select if no records available despite prefetch
-my $track = $schema->resultset("Artist")->create( {
-  artistid  => 4,
-  name      => 'Artist without CDs',
-} );
-
-$queries = 0;
-$schema->storage->debug(1);
-
-my $artist_without_cds = $schema->resultset("Artist")->find(4, {
-    join        => [qw/ cds /],
-    prefetch    => [qw/ cds /],
-});
-my @no_cds = $artist_without_cds->cds;
-
-is($queries, 1, 'prefetch ran only 1 sql statement');
-
-$schema->storage->debug(0);
-
 } # end run_tests
 
 1;
diff --git a/t/run/30join_torture.tl b/t/run/30join_torture.tl
new file mode 100644 (file)
index 0000000..181a94e
--- /dev/null
@@ -0,0 +1,25 @@
+sub run_tests {
+my $schema = shift;
+
+plan tests => 4;
+
+my $rs1 = $schema->resultset("Artist")->search({ 'tags.tag' => 'Blue' }, { join => {'cds' => 'tracks'}, prefetch => {'cds' => 'tags'} });
+my @artists = $rs1->all;
+cmp_ok(@artists, '==', 1, "Two artists returned");
+
+my $rs2 = $rs1->search({ artistid => '1' }, { join => {'cds' => {'cd_to_producer' => 'producer'} } });
+my $rs3 = $rs2->search_related('cds')->search({'cds.title' => 'Forkful of bees'});
+cmp_ok($rs3->count, '==', 3, "Three artists returned");
+
+my $rs4 = $schema->resultset("CD")->search({ 'artist.artistid' => '1' }, { join => ['tracks', 'artist'], prefetch => 'artist' });
+my @rs4_results = $rs4->all;
+
+
+is($rs4_results[0]->cdid, 1, "correct artist returned");
+
+my $rs5 = $rs4->search({'tracks.title' => 'Sticky Honey'});
+is($rs5->count, 1, "search without using previous joins okay");
+
+}
+
+1;