initial merge of Schwern's CDBICompat work, with many thanks
Matt S Trout [Fri, 27 Jul 2007 05:14:35 +0000 (05:14 +0000)]
45 files changed:
lib/DBIx/Class/CDBICompat.pm
lib/DBIx/Class/CDBICompat/AccessorMapping.pm
lib/DBIx/Class/CDBICompat/ColumnCase.pm
lib/DBIx/Class/CDBICompat/ColumnGroups.pm
lib/DBIx/Class/CDBICompat/GetSet.pm
lib/DBIx/Class/CDBICompat/ImaDBI.pm
lib/DBIx/Class/CDBICompat/LazyLoading.pm
lib/DBIx/Class/CDBICompat/LiveObjectIndex.pm
lib/DBIx/Class/CDBICompat/Retrieve.pm
lib/DBIx/Class/CDBICompat/TempColumns.pm
lib/DBIx/Class/CDBICompat/Triggers.pm
lib/DBIx/Class/DB.pm
lib/DBIx/Class/Manual/Cookbook.pod
lib/DBIx/Class/Relationship/Accessor.pm
lib/DBIx/Class/Relationship/Base.pm
lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/ResultSourceProxy/Table.pm
lib/DBIx/Class/Row.pm
lib/DBIx/Class/Serialize/Storable.pm
lib/DBIx/Class/Storage/DBI.pm
lib/SQL/Translator/Parser/DBIx/Class.pm
t/18inserterror.t
t/75limit.t
t/84serialize.t
t/cdbi-abstract/search_where.t [new file with mode: 0644]
t/cdbi-t/01-columns.t
t/cdbi-t/02-Film.t
t/cdbi-t/06-hasa.t
t/cdbi-t/14-might_have.t
t/cdbi-t/15-accessor.t
t/cdbi-t/19-set_sql.t
t/cdbi-t/21-iterator.t
t/cdbi-t/columns_dont_override_custom_accessors.t [new file with mode: 0644]
t/cdbi-t/construct.t [new file with mode: 0644]
t/cdbi-t/copy.t [new file with mode: 0644]
t/cdbi-t/discard_changes_in_DESTROY.t [new file with mode: 0644]
t/cdbi-t/hasa_without_loading.t [new file with mode: 0644]
t/cdbi-t/max_min_value_of.t [new file with mode: 0644]
t/cdbi-t/multi_column_set.t [new file with mode: 0644]
t/cdbi-t/retrieve_from_sql_with_limit.t [new file with mode: 0644]
t/cdbi-t/set_vs_DateTime.t [new file with mode: 0644]
t/deleting_many_to_many.t [new file with mode: 0644]
t/relationship_after_update.t [new file with mode: 0644]
t/relationship_doesnt_exist.t [new file with mode: 0644]
t/resultset_overload.t [new file with mode: 0644]

index 874c4c7..5ced100 100644 (file)
@@ -15,7 +15,6 @@ __PACKAGE__->load_own_components(qw/
   Constraints
   Triggers
   ReadOnly
-  GetSet
   LiveObjectIndex
   AttributeAPI
   Stringify
@@ -26,13 +25,18 @@ __PACKAGE__->load_own_components(qw/
   HasA
   HasMany
   MightHave
+  Copy
   LazyLoading
   AutoUpdate
   TempColumns
+  GetSet
   Retrieve
   Pager
   ColumnGroups
-  ImaDBI/);
+  AbstractSearch
+  ImaDBI
+  Iterator
+/);
 
             #DBIx::Class::ObjIndexStubs
 1;
@@ -74,6 +78,10 @@ provided it looks something like this:
 
 =item AccessorMapping
 
+=item AbstractSearch
+
+Compatibility with Class::DBI::AbstractSearch.
+
 =item AttributeAPI
 
 =item AutoUpdate
index c012586..1792a13 100644 (file)
@@ -6,18 +6,17 @@ use warnings;
 
 sub mk_group_accessors {
   my ($class, $group, @cols) = @_;
-  unless ($class->can('accessor_name') || $class->can('mutator_name')) {
+  unless ($class->_can_accessor_name_for || $class->_can_mutator_name_for) {
     return $class->next::method($group => @cols);
   }
   foreach my $col (@cols) {
-    my $ro_meth = ($class->can('accessor_name')
-                    ? $class->accessor_name($col)
-                    : $col);
-    my $wo_meth = ($class->can('mutator_name')
-                    ? $class->mutator_name($col)
-                    : $col);
-    #warn "$col $ro_meth $wo_meth";
-    if ($ro_meth eq $wo_meth) {
+    my $ro_meth = $class->_try_accessor_name_for($col);
+    my $wo_meth = $class->_try_mutator_name_for($col);
+
+    # warn "class: $class / col: $col / ro: $ro_meth / wo: $wo_meth\n";
+    if ($ro_meth eq $wo_meth or     # they're the same
+        $wo_meth eq $col)           # or only the accessor is custom
+    {
       $class->next::method($group => [ $ro_meth => $col ]);
     } else {
       $class->mk_group_ro_accessors($group => [ $ro_meth => $col ]);
@@ -26,16 +25,46 @@ sub mk_group_accessors {
   }
 }
 
+# CDBI 3.0.7 decided to change "accessor_name" and "mutator_name" to
+# "accessor_name_for" and "mutator_name_for".  This is recent enough
+# that we should support both.  CDBI does.
+sub _can_accessor_name_for {
+    my $class = shift;
+    return $class->can("accessor_name") || $class->can("accessor_name_for");
+}
+
+sub _can_mutator_name_for {
+    my $class = shift;
+    return $class->can("mutator_name") || $class->can("mutator_name_for");
+}
+
+sub _try_accessor_name_for {
+    my($class, $column) = @_;
+
+    my $method = $class->_can_accessor_name_for;
+    return $column unless $method;
+    return $class->$method($column);
+}
+
+sub _try_mutator_name_for {
+    my($class, $column) = @_;
+
+    my $method = $class->_can_mutator_name_for;
+    return $column unless $method;
+    return $class->$method($column);
+}
+
+
 sub new {
   my ($class, $attrs, @rest) = @_;
   $class->throw_exception( "create needs a hashref" ) unless ref $attrs eq 'HASH';
   foreach my $col ($class->columns) {
-    if ($class->can('accessor_name')) {
-      my $acc = $class->accessor_name($col);
+    if ($class->_can_accessor_name_for) {
+      my $acc = $class->_try_accessor_name_for($col);
       $attrs->{$col} = delete $attrs->{$acc} if exists $attrs->{$acc};
     }
-    if ($class->can('mutator_name')) {
-      my $mut = $class->mutator_name($col);
+    if ($class->_can_mutator_name_for) {
+      my $mut = $class->_try_mutator_name_for($col);
       $attrs->{$col} = delete $attrs->{$mut} if exists $attrs->{$mut};
     }
   }
index 9be24ff..0f847db 100644 (file)
@@ -79,18 +79,70 @@ sub _build_query {
   return \%new_query;
 }
 
+
+# CDBI will never overwrite an accessor, but it only uses one
+# accessor for all column types.  DBIC uses many different
+# accessor types so, for example, if you declare a column()
+# and then a has_a() for that same column it must overwrite.
+#
+# To make this work CDBICompat has decide if an accessor
+# method was put there by itself and only then overwrite.
+{
+  my %our_accessors;
+
+  sub _has_custom_accessor {
+    my($class, $name) = @_;
+    
+    no strict 'refs';
+    my $existing_accessor = *{$class .'::'. $name}{CODE};
+    return $existing_accessor && !$our_accessors{$existing_accessor};
+  }
+
+  sub _deploy_accessor {
+    my($class, $name, $accessor) = @_;
+
+    return if $class->_has_custom_accessor($name);
+
+    for my $name ($name, lc $name) {
+      no strict 'refs';
+      no warnings 'redefine';
+      *{$class .'::'. $name} = $accessor;
+    }
+    
+    $our_accessors{$accessor}++;
+
+    return 1;
+  }
+}
+
 sub _mk_group_accessors {
   my ($class, $type, $group, @fields) = @_;
-  #warn join(', ', map { ref $_ ? (@$_) : ($_) } @fields);
-  my @extra;
-  foreach (@fields) {
-    my ($acc, $field) = ref $_ ? @$_ : ($_, $_);
-    #warn "$acc ".lc($acc)." $field";
-    next if defined &{"${class}::${acc}"};
-    push(@extra, [ lc $acc => $field ]);
+
+  # So we don't have to do lots of lookups inside the loop.
+  my $maker = $class->can($type) unless ref $type;
+
+  # warn "$class $type $group\n";
+  foreach my $field (@fields) {
+    if( $field eq 'DESTROY' ) {
+        carp("Having a data accessor named DESTROY in ".
+             "'$class' is unwise.");
+    }
+
+    my $name = $field;
+
+    ($name, $field) = @$field if ref $field;
+
+    my $accessor = $class->$maker($group, $field);
+    my $alias = "_${name}_accessor";
+
+    # warn "  $field $alias\n";
+    {
+      no strict 'refs';
+      
+      $class->_deploy_accessor($name,  $accessor);
+      $class->_deploy_accessor($alias, $accessor);
+    }
   }
-  return $class->next::method($type, $group,
-                                                     @fields, @extra);
 }
 
 sub new {
index 98e6508..829f589 100644 (file)
@@ -12,6 +12,8 @@ sub columns {
   my $proto = shift;
   my $class = ref $proto || $proto;
   my $group = shift || "All";
+  $class->_init_result_source_instance();
+
   $class->_add_column_group($group => @_) if @_;
   return $class->all_columns    if $group eq "All";
   return $class->primary_column if $group eq "Primary";
index 6b98e79..a11baeb 100644 (file)
@@ -16,7 +16,13 @@ sub get {
 }
 
 sub set {
-  return shift->set_column(@_);
+  my($self, %data) = @_;
+
+  # set_columns() is going to do a string comparison before setting.
+  # This breaks on DateTime objects (whose comparison is arguably broken)
+  # so we stringify anything first.
+  $data{$_} = "$data{$_}" for keys %data;
+  return shift->set_columns(\%data);
 }
 
 1;
index 880eb9d..0a143fa 100644 (file)
@@ -8,7 +8,7 @@ use DBIx::ContextualFetch;
 use base qw/DBIx::Class/;
 
 __PACKAGE__->mk_classdata('_transform_sql_handler_order'
-                            => [ qw/TABLE ESSENTIAL JOIN/ ] );
+                            => [ qw/TABLE ESSENTIAL JOIN IDENTIFIER/ ] );
 
 __PACKAGE__->mk_classdata('_transform_sql_handlers' =>
   {
@@ -24,8 +24,14 @@ __PACKAGE__->mk_classdata('_transform_sql_handlers' =>
     'ESSENTIAL' =>
       sub {
         my ($self, $class, $data) = @_;
-        return join(' ', $class->columns('Essential')) unless $data;
-        return join(' ', $self->{_classes}{$data}->columns('Essential'));
+        $class = $data ? $self->{_classes}{$data} : $class;
+        return join(', ', $class->columns('Essential'));
+      },
+    'IDENTIFIER' =>
+      sub {
+        my ($self, $class, $data) = @_;
+        $class = $data ? $self->{_classes}{$data} : $class;
+        return join ' AND ', map  "$_ = ?", $class->primary_columns;
       },
     'JOIN' =>
       sub {
index b7d3633..add9390 100644 (file)
@@ -22,6 +22,28 @@ sub get_column {
   $self->next::method(@_[1..$#_]);
 }
 
+# CDBI does not explicitly declare auto increment columns, so
+# we just clear out our primary columns before copying.
+sub copy {
+  my($self, $changes) = @_;
+
+  for my $col ($self->primary_columns) {
+    $changes->{$col} = undef unless exists $changes->{$col};
+  }
+  
+  return $self->next::method($changes);
+}
+
+sub discard_changes {
+  my($self) = shift;
+
+  delete $self->{_column_data}{$_} for $self->is_changed;
+  delete $self->{_dirty_columns};
+  delete $self->{_relationship_data};
+
+  return $self;
+}
+
 sub _ident_cond {
   my ($class) = @_;
   return join(" AND ", map { "$_ = ?" } $class->primary_columns);
index fb8a77e..11238dc 100644 (file)
@@ -67,16 +67,4 @@ sub inflate_result {
   return $new;
 }
 
-sub discard_changes {
-  my ($self) = @_;
-  if (my $key = $self->ID) {
-    $self->remove_from_object_index;
-    my $ret = $self->next::method;
-    $self->live_object_index->{$key} = $self if $self->in_storage;
-    return $ret;
-  } else {
-    return $self->next::method;
-  }
-}
-
 1;
index 1186ae4..4c36887 100644 (file)
@@ -47,12 +47,35 @@ sub _build_query {
 
 sub retrieve_from_sql {
   my ($class, $cond, @rest) = @_;
+
   $cond =~ s/^\s*WHERE//i;
-  $class->search_literal($cond, @rest);
+
+  if( $cond =~ s/\bLIMIT (\d+)\s*$//i ) {
+      push @rest, { rows => $1 };
+  }
+
+  return $class->search_literal($cond, @rest);
+}
+
+sub construct {
+    my $class = shift;
+    my $obj = $class->resultset_instance->new_result(@_);
+    $obj->in_storage(1);
+    
+    return $obj;
 }
 
 sub retrieve_all      { shift->search              }
 sub count_all         { shift->count               }
-  # Contributed by Numa. No test for this though.
+
+sub maximum_value_of  {
+    my($class, $col) = @_;
+    return $class->resultset_instance->get_column($col)->max;
+}
+
+sub minimum_value_of  {
+    my($class, $col) = @_;
+    return $class->resultset_instance->get_column($col)->min;
+}
 
 1;
index 95be2a8..d025bb8 100644 (file)
@@ -22,17 +22,26 @@ sub _add_column_group {
 
 sub new {
   my ($class, $attrs, @rest) = @_;
-  my %temp;
-  foreach my $key (keys %$attrs) {
-    $temp{$key} = delete $attrs->{$key} if $class->_temp_columns->{$key};
-  }
+
+  my $temp = $class->_extract_temp_data($attrs);
+
   my $new = $class->next::method($attrs, @rest);
-  foreach my $key (keys %temp) {
-    $new->set_temp($key, $temp{$key});
-  }
+
+  $new->set_temp($_, $temp->{$_}) for keys %$temp;
+
   return $new;
 }
 
+sub _extract_temp_data {
+  my($self, $data) = @_;
+
+  my %temp;
+  foreach my $key (keys %$data) {
+    $temp{$key} = delete $data->{$key} if $self->_temp_columns->{$key};
+  }
+
+  return \%temp;
+}
 
 sub find_column {
   my ($class, $col, @rest) = @_;
@@ -40,6 +49,16 @@ sub find_column {
   return $class->next::method($col, @rest);
 }
 
+sub set {
+  my($self, %data) = @_;
+  
+  my $temp_data = $self->_extract_temp_data(\%data);
+  
+  $self->set_temp($_, $temp_data->{$_}) for keys %$temp_data;
+  
+  return $self->next::method(%data);
+}
+
 sub get_temp {
   my ($self, $column) = @_;
   $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
index 2c4ff30..3f6aef7 100644 (file)
@@ -7,6 +7,9 @@ use Class::Trigger;
 
 sub insert {
   my $self = shift;
+
+  return $self->create(@_) unless ref $self;
+
   $self->call_trigger('before_create');
   $self->next::method(@_);
   $self->call_trigger('after_create');
index e502278..6297850 100644 (file)
@@ -161,7 +161,7 @@ sub result_source_instance {
   return $class->_result_source_instance(@_) if @_;
 
   my $source = $class->_result_source_instance;
-  return {} unless Scalar::Util::blessed($source);
+  return unless Scalar::Util::blessed($source);
 
   if ($source->result_class ne $class) {
     # Remove old source instance so we dont get deep recursion
index 1bc0c8a..70e645c 100644 (file)
@@ -600,7 +600,7 @@ It's as simple as overriding the C<new> method.  Note the use of
 C<next::method>.
 
   sub new {
-    my ( $class, $attrs ) = @_;
+    my ( $self, $attrs ) = @_;
 
     $attrs->{foo} = 'bar' unless defined $attrs->{foo};
 
index b20eb16..76183de 100644 (file)
@@ -36,7 +36,7 @@ sub add_relationship_accessor {
     $class->inflate_column($rel,
       { inflate => sub {
           my ($val, $self) = @_;
-          return $self->find_or_create_related($rel, {}, {});
+          return $self->find_or_new_related($rel, {}, {});
         },
         deflate => sub {
           my ($val, $self) = @_;
index 1fbcf52..09dfbbf 100644 (file)
@@ -288,7 +288,8 @@ L<DBIx::Class::Row/insert> on it.
 
 sub find_or_new_related {
   my $self = shift;
-  return $self->find_related(@_) || $self->new_related(@_);
+  my $obj = $self->find_related(@_);
+  return defined $obj ? $obj : $self->new_related(@_);
 }
 
 =head2 find_or_create_related
index 75ba410..4f9bb92 100644 (file)
@@ -3,8 +3,8 @@ package DBIx::Class::ResultSet;
 use strict;
 use warnings;
 use overload
-        '0+'     => \&count,
-        'bool'   => sub { 1; },
+        '0+'     => "count",
+        'bool'   => "_bool",
         fallback => 1;
 use Carp::Clan qw/^DBIx::Class/;
 use Data::Page;
@@ -50,6 +50,10 @@ In the examples below, the following table classes are used:
   __PACKAGE__->belongs_to(artist => 'MyApp::Schema::Artist');
   1;
 
+=head1 OVERLOADING
+
+If a resultset is used as a number it returns the C<count()>.  However, if it is used as a boolean it is always true.  So if you want to check if a result set has any results use C<if $rs != 0>.  C<if $rs> will always be true.
+
 =head1 METHODS
 
 =head2 new
@@ -976,6 +980,10 @@ sub _count { # Separated out so pager can get the full count
   return $count;
 }
 
+sub _bool {
+  return 1;
+}
+
 =head2 count_literal
 
 =over 4
index ce78cb8..474c330 100644 (file)
@@ -12,6 +12,42 @@ __PACKAGE__->mk_classdata(table_class => 'DBIx::Class::ResultSource::Table');
 __PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do
                                           # anything yet!
 
+sub _init_result_source_instance {
+    my $class = shift;
+
+    $class->mk_classdata('result_source_instance')
+        unless $class->can('result_source_instance');
+
+    my $table = $class->result_source_instance;
+    my $class_has_table_instance = ($table and $table->result_class eq $class);
+    return $table if $class_has_table_instance;
+
+    if( $table ) {
+        $table = $class->table_class->new({
+            %$table,
+            result_class => $class,
+            source_name => undef,
+            schema => undef
+        });
+    }
+    else {
+        $table = $class->table_class->new({
+            name            => undef,
+            result_class    => $class,
+            source_name     => undef,
+        });
+    }
+
+    $class->result_source_instance($table);
+
+    if ($class->can('schema_instance')) {
+        $class =~ m/([^:]+)$/;
+        $class->schema_instance->register_class($class, $class);
+    }
+
+    return $table;
+}
+
 =head1 NAME
 
 DBIx::Class::ResultSourceProxy::Table - provides a classdata table
@@ -47,7 +83,7 @@ sub table {
   unless (ref $table) {
     $table = $class->table_class->new({
         $class->can('result_source_instance') ?
-          %{$class->result_source_instance} : (),
+          %{$class->result_source_instance||{}} : (),
         name => $table,
         result_class => $class,
         source_name => undef,
index 7195bba..341ab29 100644 (file)
@@ -48,7 +48,9 @@ sub new {
   my ($class, $attrs) = @_;
   $class = ref $class if ref $class;
 
-  my $new = { _column_data => {} };
+  my $new = {
+      _column_data          => {},
+  };
   bless $new, $class;
 
   if (my $handle = delete $attrs->{-source_handle}) {
@@ -486,6 +488,10 @@ sub set_column {
   my $ret = $self->store_column(@_);
   $self->{_dirty_columns}{$column} = 1
     if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
+
+  # XXX clear out the relation cache for this column
+  delete $self->{related_resultsets}{$column};
+
   return $ret;
 }
 
index 7ccd2b0..5795293 100644 (file)
@@ -4,15 +4,20 @@ use warnings;
 use Storable;
 
 sub STORABLE_freeze {
-    my ($self,$cloning) = @_;
+    my ($self, $cloning) = @_;
     my $to_serialize = { %$self };
+
     delete $to_serialize->{result_source};
-    return (Storable::freeze($to_serialize));
+    delete $to_serialize->{related_resultsets};
+    delete $to_serialize->{_inflated_column};
+
+    return('', $to_serialize);
 }
 
 sub STORABLE_thaw {
-    my ($self,$cloning,$serialized) = @_;
-    %$self = %{ Storable::thaw($serialized) };
+    my ($self, $cloning, $junk, $obj) = @_;
+
+    %$self = %{ $obj };
     $self->result_source($self->result_source_instance)
       if $self->can('result_source_instance');
 }
index f676ec1..af2431e 100644 (file)
@@ -1027,6 +1027,9 @@ sub _select {
   } else {
     $self->throw_exception("rows attribute must be positive if present")
       if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
+
+    # MySQL actually recommends this approach.  I cringe.
+    $attrs->{rows} = 2**48 if not defined $attrs->{rows} and defined $attrs->{offset};
     push @args, $attrs->{rows}, $attrs->{offset};
   }
   return $self->_execute(@args);
index e3f0860..fd5762a 100644 (file)
@@ -43,8 +43,6 @@ sub parse {
 
 #    print Dumper($dbixschema->registered_classes);
 
-    #foreach my $tableclass ($dbixschema->registered_classes)
-
     my %seen_tables;
 
     my @monikers = $dbixschema->sources;
index 043cec5..005209a 100644 (file)
@@ -7,19 +7,23 @@ BEGIN {
     eval "use DBD::SQLite";
     plan $@
         ? ( skip_all => 'needs DBD::SQLite for testing' )
-        : ( tests => 3 );
+        : ( tests => 4 );
 }
 
 use lib qw(t/lib);
 
 use_ok( 'DBICTest' );
-
 use_ok( 'DBICTest::Schema' );
+my $schema = DBICTest->init_schema;
 
 {
        my $warnings;
        local $SIG{__WARN__} = sub { $warnings .= $_[0] };
-       eval { DBICTest::CD->create({ title => 'vacation in antarctica' }) };
+       eval {
+         $schema->resultset('CD')
+                ->create({ title => 'vacation in antarctica' })
+       };
+       like $@, qr/NULL/;  # as opposed to some other error
        ok( $warnings !~ /uninitialized value/, "No warning from Storage" );
 }
 
index 0fc7e3a..881668d 100644 (file)
@@ -9,8 +9,8 @@ my $schema = DBICTest->init_schema();
 
 BEGIN {
     eval "use DBD::SQLite";
-    plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 9);
-}                                                                               
+    plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 10);
+}
 
 # test LIMIT
 my $it = $schema->resultset("CD")->search( {},
@@ -51,6 +51,15 @@ is( $it->next, undef, "software next past end of resultset ok" );
 );
 is( $cds[0]->title, "Spoonful of bees", "software offset ok" );
 
+
+@cds = $schema->resultset("CD")->search( {},
+    {
+      offset => 2,
+      order_by => 'year' }
+);
+is( $cds[0]->title, "Spoonful of bees", "offset with no limit" );
+
+
 # based on a failing criteria submitted by waswas
 # requires SQL::Abstract >= 1.20
 $it = $schema->resultset("CD")->search(
index a8cedf0..8940021 100644 (file)
@@ -4,13 +4,33 @@ use warnings;
 use Test::More;
 use lib qw(t/lib);
 use DBICTest;
-use Storable;
+use Storable qw(dclone freeze thaw);
 
 my $schema = DBICTest->init_schema();
 
-plan tests => 1;
+my %stores = (
+    dclone          => sub { return dclone($_[0]) },
+    "freeze/thaw"   => sub { return thaw(freeze($_[0])) },
+);
 
-my $artist = $schema->resultset('Artist')->find(1);
-my $copy = eval { Storable::dclone($artist) };
-is_deeply($copy, $artist, 'serialize row object works');
+plan tests => (5 * keys %stores);
 
+for my $name (keys %stores) {
+    my $store = $stores{$name};
+
+    my $artist = $schema->resultset('Artist')->find(1);
+    my $copy = eval { $store->($artist) };
+    is_deeply($copy, $artist, "serialize row object works: $name");
+
+    # Test that an object with a related_resultset can be serialized.
+    my @cds = $artist->related_resultset("cds");
+    ok $artist->{related_resultsets}, 'has key: related_resultsets';
+
+    $copy = eval { $store->($artist) };
+    for my $key (keys %$artist) {
+        next if $key eq 'related_resultsets';
+        next if $key eq '_inflated_column';
+        is_deeply($copy->{$key}, $artist->{$key},
+                  qq[serialize with related_resultset "$key"]);
+    }
+}
diff --git a/t/cdbi-abstract/search_where.t b/t/cdbi-abstract/search_where.t
new file mode 100644 (file)
index 0000000..3161299
--- /dev/null
@@ -0,0 +1,67 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+
+use strict;
+use warnings;
+
+BEGIN {
+  eval "use DBIx::Class::CDBICompat;";
+  if ($@) {
+    plan (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@");
+    next;
+  }
+  eval "use DBD::SQLite";
+  plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 9);
+}
+
+INIT {
+       use lib 't/testlib';
+       use Film;
+}
+
+
+Film->create({ Title => $_, Rating => "PG" }) for ("Superman", "Super Fuzz");
+Film->create({ Title => "Batman", Rating => "PG13" });
+
+my $superman = Film->search_where( Title => "Superman" );
+is $superman->next->Title, "Superman", "search_where() as iterator";
+is $superman->next, undef;
+
+my @all = Film->search_where({}, { order_by => "Title ASC" });
+is_deeply ["Batman", "Super Fuzz", "Superman"],
+          [map $_->Title, @all],
+          "order_by ASC";
+
+@all = Film->search_where({}, { order_by => "Title DESC" });
+is_deeply ["Superman", "Super Fuzz", "Batman"],
+          [map $_->Title, @all],
+          "order_by DESC";
+
+@all = Film->search_where({ Rating => "PG" }, { limit => 1, order_by => "Title ASC" });
+is_deeply ["Super Fuzz"],
+          [map $_->Title, @all],
+          "where, limit";
+
+@all = Film->search_where({}, { limit => 2, order_by => "Title ASC" });
+is_deeply ["Batman", "Super Fuzz"],
+          [map $_->Title, @all],
+          "limit";
+
+@all = Film->search_where({}, { offset => 1, order_by => "Title ASC" });
+is_deeply ["Super Fuzz", "Superman"],
+          [map $_->Title, @all],
+          "offset";
+
+@all = Film->search_where({}, { limit => 1, offset => 1, order_by => "Title ASC" });
+is_deeply ["Super Fuzz"],
+          [map $_->Title, @all],
+          "limit + offset";
+
+@all = Film->search_where({}, { limit => 2, offset => 1,
+                                limit_dialect => "Top", order_by => "Title ASC"
+                              });
+is_deeply ["Super Fuzz", "Superman"],
+          [map $_->Title, @all],
+          "limit_dialect ignored";
+
index 658c500..7b3b1c0 100644 (file)
@@ -4,7 +4,7 @@ use Test::More;
 
 BEGIN {
   eval "use DBIx::Class::CDBICompat;";
-  plan $@ ? (skip_all => 'Class::Trigger and DBIx::ContextualFetch required') : (tests=> 24);
+  plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@") : (tests=> 24);
 }
 
 
index d303f35..6a4d7f6 100644 (file)
@@ -37,7 +37,7 @@ is(Film->__driver, "SQLite", "Driver set correctly");
        ok $@, "Can't get title with no object";
 } 
 
-eval { my $duh = Film->create; };
+eval { my $duh = Film->insert; };
 like $@, qr/create needs a hashref/, "needs a hashref";
 
 ok +Film->create_test_film;
@@ -163,11 +163,11 @@ is($blrunner_dc->NumExplodingSheep, undef, 'Sheep correct');
 }
 
 eval {
-       my $ishtar = Film->create({ Title => 'Ishtar', Director => 'Elaine May' });
+       my $ishtar = Film->insert({ Title => 'Ishtar', Director => 'Elaine May' });
        my $mandn =
-               Film->create({ Title => 'Mikey and Nicky', Director => 'Elaine May' });
+               Film->insert({ Title => 'Mikey and Nicky', Director => 'Elaine May' });
        my $new_leaf =
-               Film->create({ Title => 'A New Leaf', Director => 'Elaine May' });
+               Film->insert({ Title => 'A New Leaf', Director => 'Elaine May' });
 
 #use Data::Dumper; die Dumper(Film->search( Director => 'Elaine May' ));
        cmp_ok(Film->search(Director => 'Elaine May'), '==', 3,
@@ -263,7 +263,7 @@ SKIP: {
 
 {                               # update deleted object
        my $rt = "Royal Tenenbaums";
-       my $ten = Film->create({ title => $rt, Rating => "R" });
+       my $ten = Film->insert({ title => $rt, Rating => "R" });
        $ten->rating(18);
        Film->set_sql(drt => "DELETE FROM __TABLE__ WHERE title = ?");
        Film->sql_drt->execute($rt);
@@ -284,7 +284,7 @@ SKIP: {
 
 # Primary key of 0
 {
-       my $zero = Film->create({ Title => 0, Rating => "U" });
+       my $zero = Film->insert({ Title => 0, Rating => "U" });
        ok defined $zero, "Create 0";
        ok my $ret = Film->retrieve(0), "Retrieve 0";
        is $ret->Title,  0,   "Title OK";
@@ -344,7 +344,7 @@ if (0) {
 
 {
        {
-               ok my $byebye = DeletingFilm->create(
+               ok my $byebye = DeletingFilm->insert(
                        {
                                Title  => 'Goodbye Norma Jean',
                                Rating => 'PG',
@@ -386,7 +386,7 @@ SKIP: {
        isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste4),
                "Clearing cache and retrieving again gives new object";
  
-  $btaste=Film->create({
+  $btaste=Film->insert({
                Title             => 'Bad Taste 2',
                Director          => 'Peter Jackson',
                Rating            => 'R',
index 94757c3..56a1f86 100644 (file)
@@ -4,7 +4,7 @@ use Test::More;
 BEGIN {
   eval "use DBIx::Class::CDBICompat;";
   if ($@) {
-    plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+    plan (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@");
     next;
   }
   eval "use DBD::SQLite";
index 40b186e..febdd70 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
     next;
   }
   eval "use DBD::SQLite";
-  plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 18);
+  plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 22);
 }
 
 use lib 't/testlib';
@@ -67,4 +67,17 @@ Film->create_test_film;
                
 }
 
-       
+{
+    my $host = Film->create({ title => "Gwoemul" });
+    $host->blurb("Monsters are real.");
+    my $info = $host->info;
+    is $info->blurb, "Monsters are real.";
+
+    $host->discard_changes;
+    is $host->info->id, $info->id,
+        'relationships still valid after discard_changes';
+
+    ok $host->info->delete;
+    $host->discard_changes;
+    ok !$host->info, 'relationships rechecked after discard_changes';
+}
\ No newline at end of file
index e683f7d..ad76ad1 100644 (file)
@@ -4,11 +4,12 @@ use Test::More;
 BEGIN {
   eval "use DBIx::Class::CDBICompat;";
   if ($@) {
+      diag $@;
     plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
     next;
   }
   eval "use DBD::SQLite";
-  plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 53);
+  plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 54);
 }
 
 INIT {
@@ -17,7 +18,9 @@ INIT {
        use lib 't/testlib';
        require Film;
        require Actor;
+        require Director;
        Actor->has_a(film => 'Film');
+        Film->has_a(director => 'Director');
        sub Class::DBI::sheep { ok 0; }
 }
 
@@ -33,12 +36,19 @@ sub Film::accessor_name {
        return $col;
 }
 
-sub Actor::accessor_name {
+sub Actor::accessor_name_for {
        my ($class, $col) = @_;
        return "movie" if lc $col eq "film";
        return $col;
 }
 
+# This is a class with accessor_name_for() but no corresponding mutatori_name_for()
+sub Director::accessor_name_for {
+    my($class, $col) = @_;
+    return "nutty_as_a_fruitcake" if lc $col eq "isinsane";
+    return $col;
+}
+
 my $data = {
        Title    => 'Bad Taste',
        Director => 'Peter Jackson',
@@ -131,8 +141,20 @@ eval {
 
 }
 
-SKIP: {    # have non persistent accessor?
-        #skip "Compat layer doesn't handle TEMP columns yet", 11;
+
+# Make sure a class with an accessor_name() method has a similar mutator.
+{
+    my $aki = Director->create({
+        name     => "Aki Kaurismaki",
+    });
+
+    $aki->nutty_as_a_fruitcake(1);
+    is $aki->nutty_as_a_fruitcake, 1,
+        "a custom accessor without a custom mutator is setable";
+    $aki->update;
+}
+
+{
        Film->columns(TEMP => qw/nonpersistent/);
        ok(Film->find_column('nonpersistent'), "nonpersistent is a column");
        ok(!Film->has_real_column('nonpersistent'), " - but it's not real");
@@ -152,8 +174,7 @@ SKIP: {    # have non persistent accessor?
        }
 }
 
-SKIP: {    # was bug with TEMP and no Essential
-        #skip "Compat layer doesn't have TEMP columns yet", 5;
+{
        is_deeply(
                Actor->columns('Essential'),
                Actor->columns('Primary'),
@@ -166,8 +187,7 @@ SKIP: {    # was bug with TEMP and no Essential
        isa_ok $pj => "Actor";
 }
 
-SKIP: {
-        #skip "Compat layer doesn't handle read-only objects yet", 10;
+{
        Film->autoupdate(1);
        my $naked = Film->create({ title => 'Naked' });
        my $sandl = Film->create({ title => 'Secrets and Lies' });
index 36b66af..f725c89 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
     next;
   }
   eval "use DBD::SQLite";
-  plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 17);
+  plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 20);
 }
 
 use lib 't/testlib';
@@ -19,6 +19,11 @@ use Actor;
        my @cols = Film->columns('Essential');
        is_deeply \@cols, ['title'], "1 Column in essential";
        is +Film->transform_sql('__ESSENTIAL__'), 'title', '__ESSENTIAL__ expansion';
+       
+       # This provides a more interesting test
+       Film->columns(Essential => qw(title rating));
+       is +Film->transform_sql('__ESSENTIAL__'), 'title, rating',
+           'multi-col __ESSENTIAL__ expansion';
 }
 
 my $f1 = Film->create({ title => 'A', director => 'AA', rating => 'PG' });
@@ -68,6 +73,22 @@ Film->set_sql(
 };
 
 {
+    Film->set_sql(
+        by_id => qq{
+            SELECT  __ESSENTIAL__
+            FROM    __TABLE__
+            WHERE   __IDENTIFIER__
+        }
+    );
+    
+    my $film = Film->retrieve_all->first;
+    my @found = Film->search_by_id($film->id);
+    is @found, 1;
+    is $found[0]->id, $film->id;
+}
+
+
+{
        Actor->has_a(film => "Film");
        Film->set_sql(
                namerate => qq{
@@ -109,4 +130,3 @@ Film->set_sql(
        is $apg[1]->title, "B", "and B";
 }
 
-#} # end SKIP block
index 3c84f4c..d524423 100644 (file)
@@ -4,11 +4,11 @@ use Test::More;
 BEGIN {
   eval "use DBIx::Class::CDBICompat;";
   if ($@) {
-    plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+    plan (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@");
     next;
   }
   eval "use DBD::SQLite";
-  plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 33);
+  plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 37);
 }
 
 use lib 't/testlib';
@@ -49,8 +49,6 @@ my @film  = (
        is $it->next->title, "Film 2", "And 2 is still next";
 }
 
-SKIP: {
-  #skip "Iterator doesn't yet have slice support", 19;
 
 {
        my $it = Film->retrieve_all;
@@ -85,4 +83,14 @@ SKIP: {
        is $it->next->title, "Film 2", "And 2 is still next";
 }
 
-} # End SKIP
+{
+  my $it = Film->retrieve_all;
+  is $it, $it->count, "iterator returns count as a scalar";
+  ok $it, "iterator returns true when there are results";
+}
+
+{
+  my $it = Film->search( Title => "something which does not exist" );
+  is $it, 0;
+  ok !$it, "iterator returns false when no results";
+}
diff --git a/t/cdbi-t/columns_dont_override_custom_accessors.t b/t/cdbi-t/columns_dont_override_custom_accessors.t
new file mode 100644 (file)
index 0000000..4111b72
--- /dev/null
@@ -0,0 +1,34 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+BEGIN {
+  eval "use DBIx::Class::CDBICompat;";
+  plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+          : (tests=> 5);
+}
+
+{
+    package Thing;
+
+    use base 'DBIx::Class::Test::SQLite';
+
+    Thing->columns(TEMP => qw[foo bar]);
+    Thing->columns(All  => qw[thing_id yarrow flower]);
+    sub foo { 42 }
+    sub yarrow { "hock" }
+}
+
+is_deeply( [sort Thing->columns("TEMP")],
+           [sort qw(foo bar)],
+           "TEMP columns set"
+);
+my $thing = Thing->construct(
+    { thing_id => 23, foo => "this", bar => "that" }
+);
+
+is( $thing->id, 23 );
+is( $thing->yarrow, "hock", 'custom accessor not overwritten by column' );
+is( $thing->foo, 42, 'custom routine not overwritten by temp column' );
+is( $thing->bar, "that", 'temp column accessor generated' );
diff --git a/t/cdbi-t/construct.t b/t/cdbi-t/construct.t
new file mode 100644 (file)
index 0000000..59adef1
--- /dev/null
@@ -0,0 +1,31 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+BEGIN {
+  eval "use DBIx::Class::CDBICompat;";
+  plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+          : (tests=> 4);
+}
+
+INIT {
+    use lib 't/testlib';
+    use Film;
+}
+
+Film->insert({
+    Title     => "Breaking the Waves",
+    Director  => 'Lars von Trier',
+    Rating    => 'R'
+});
+
+my $film = Film->construct({
+    Title     => "Breaking the Waves",
+    Director  => 'Lars von Trier',
+});
+
+isa_ok $film, "Film";
+is $film->title, "Breaking the Waves";
+is $film->director, "Lars von Trier";
+is $film->rating, "R", "constructed objects can get missing data from the db";
\ No newline at end of file
diff --git a/t/cdbi-t/copy.t b/t/cdbi-t/copy.t
new file mode 100644 (file)
index 0000000..cdcae15
--- /dev/null
@@ -0,0 +1,43 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+BEGIN {
+  eval "use DBIx::Class::CDBICompat;";
+  plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+          : (tests=> 4);
+}
+
+INIT {
+    use lib 't/testlib';
+}
+
+{
+    package # hide from PAUSE 
+        MyFilm;
+
+    use base 'DBIx::Class::Test::SQLite';
+    use strict;
+
+    __PACKAGE__->set_table('Movies');
+    __PACKAGE__->columns(All => qw(id title));
+
+    sub create_sql {
+        return qq{
+                id              INTEGER PRIMARY KEY AUTOINCREMENT,
+                title           VARCHAR(255)
+        }
+    }
+}
+
+my $film = MyFilm->create({ title => "For Your Eyes Only" });
+ok $film->id;
+
+my $new_film = $film->copy;
+ok $new_film->id;
+isnt $new_film->id, $film->id, "copy() gets new primary key";
+
+$new_film = $film->copy(42);
+is $new_film->id, 42, "copy() with new id";
+
diff --git a/t/cdbi-t/discard_changes_in_DESTROY.t b/t/cdbi-t/discard_changes_in_DESTROY.t
new file mode 100644 (file)
index 0000000..950d9bd
--- /dev/null
@@ -0,0 +1,29 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+BEGIN {
+  eval "use DBIx::Class::CDBICompat;";
+  plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+          : (tests=> 1);
+}
+
+INIT {
+    use lib 't/testlib';
+    use Film;
+}
+
+{
+    my @warnings;
+    local $SIG{__WARN__} = sub { push @warnings, @_; };
+    {
+        # Test that this doesn't cause infinite recursion.
+        local *Film::DESTROY;
+        local *Film::DESTROY = sub { $_[0]->discard_changes };
+        
+        my $film = Film->insert({ Title => "Eegah!" });
+        $film->director("Arch Hall Sr.");
+    }
+    is_deeply \@warnings, [];
+}
\ No newline at end of file
diff --git a/t/cdbi-t/hasa_without_loading.t b/t/cdbi-t/hasa_without_loading.t
new file mode 100644 (file)
index 0000000..5b8cbdf
--- /dev/null
@@ -0,0 +1,23 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+BEGIN {
+  eval "use DBIx::Class::CDBICompat;";
+  plan $@ ? (skip_all => 'Class::Trigger and DBIx::ContextualFetch required')
+          : (tests=> 3);
+}
+
+package Foo;
+
+use base qw(Class::DBI);
+
+eval {
+    Foo->table("foo");
+    Foo->columns(Essential => qw(foo bar));
+    Foo->has_a( bar => "This::Does::Not::Exist::Yet" );
+};
+::is $@, '';
+::is(Foo->table, "foo");
+::is_deeply [sort map lc, Foo->columns], [sort map lc, qw(foo bar)];
diff --git a/t/cdbi-t/max_min_value_of.t b/t/cdbi-t/max_min_value_of.t
new file mode 100644 (file)
index 0000000..f4a0bda
--- /dev/null
@@ -0,0 +1,34 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+#----------------------------------------------------------------------
+# Test database failures
+#----------------------------------------------------------------------
+
+BEGIN {
+  eval "use DBIx::Class::CDBICompat;";
+  if ($@) {
+    plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+    next;
+  }
+  eval "use DBD::SQLite";
+  plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 2);
+}
+
+use lib 't/testlib';
+use Film;
+
+Film->create({
+    title => "Bad Taste",
+    numexplodingsheep => 10,
+});
+
+Film->create({
+    title => "Evil Alien Conquerers",
+    numexplodingsheep => 2,
+});
+
+is( Film->maximum_value_of("numexplodingsheep"), 10 );
+is( Film->minimum_value_of("numexplodingsheep"), 2  );
diff --git a/t/cdbi-t/multi_column_set.t b/t/cdbi-t/multi_column_set.t
new file mode 100644 (file)
index 0000000..eb985e3
--- /dev/null
@@ -0,0 +1,27 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+BEGIN {
+  eval "use DBIx::Class::CDBICompat;";
+  plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+          : (tests=> 3);
+}
+
+{
+    package Thing;
+
+    use base 'DBIx::Class::Test::SQLite';
+
+    Thing->columns(TEMP => qw[foo bar baz]);
+    Thing->columns(All  => qw[some real stuff]);
+}
+
+my $thing = Thing->construct({ foo => 23, some => 42, baz => 99 });
+$thing->set( foo => "wibble", some => "woosh" );
+is $thing->foo, "wibble";
+is $thing->some, "woosh";
+is $thing->baz, 99;
+
+$thing->discard_changes;
diff --git a/t/cdbi-t/retrieve_from_sql_with_limit.t b/t/cdbi-t/retrieve_from_sql_with_limit.t
new file mode 100644 (file)
index 0000000..e0c452d
--- /dev/null
@@ -0,0 +1,27 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+BEGIN {
+  eval "use DBIx::Class::CDBICompat;";
+  plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+          : (tests=> 3);
+}
+
+INIT {
+    use lib 't/testlib';
+    use Film;
+}
+
+for my $title ("Bad Taste", "Braindead", "Forgotten Silver") {
+    Film->insert({ Title => $title, Director => 'Peter Jackson' });
+}
+
+Film->insert({ Title => "Transformers", Director => "Michael Bay"});
+
+{
+    my @films = Film->retrieve_from_sql(qq[director = "Peter Jackson" LIMIT 2]);
+    is @films, 2, "retrieve_from_sql with LIMIT";
+    is( $_->director, "Peter Jackson" ) for @films;
+}
diff --git a/t/cdbi-t/set_vs_DateTime.t b/t/cdbi-t/set_vs_DateTime.t
new file mode 100644 (file)
index 0000000..84842bf
--- /dev/null
@@ -0,0 +1,28 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+BEGIN {
+  eval "use DBIx::Class::CDBICompat;";
+  plan skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@"
+    if $@;
+  plan skip_all => "DateTime required" unless eval { require DateTime };
+  plan tests => 1;
+}
+
+{
+    package Thing;
+
+    use base 'DBIx::Class::Test::SQLite';
+
+    Thing->columns(All  => qw[thing_id this that date]);
+}
+
+my $thing = Thing->construct({ thing_id => 23, date => "01-02-1994" });
+eval {
+  $thing->set( date => DateTime->now );
+};
+is $@, '';
+
+$thing->discard_changes;
diff --git a/t/deleting_many_to_many.t b/t/deleting_many_to_many.t
new file mode 100644 (file)
index 0000000..5613721
--- /dev/null
@@ -0,0 +1,23 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;  
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 5;
+
+my $cd = $schema->resultset("CD")->find(2);
+ok $cd->liner_notes;
+ok keys %{$cd->{_relationship_data}}, "_relationship_data populated";
+
+$cd->discard_changes;
+ok $cd->liner_notes, 'relationships still valid after discarding changes';
+
+ok $cd->liner_notes->delete;
+$cd->discard_changes;
+ok !$cd->liner_notes, 'discard_changes resets relationship';
\ No newline at end of file
diff --git a/t/relationship_after_update.t b/t/relationship_after_update.t
new file mode 100644 (file)
index 0000000..aaf7300
--- /dev/null
@@ -0,0 +1,30 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;  
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 2;
+
+my $bookmark = $schema->resultset("Bookmark")->find(1);
+my $link = $bookmark->link;
+my $link_id = $link->id;
+
+my $new_link = $schema->resultset("Link")->new({
+    id      => 42,
+    url     => "http://monstersarereal.com",
+    title   => "monstersarereal.com"
+});
+
+# Changing a relationship by id rather than by object would cause
+# old related_resultsets to be used.
+$bookmark->link($new_link->id);
+is $bookmark->link->id, $new_link->id;
+
+$bookmark->update;
+is $bookmark->link->id, $new_link->id;
diff --git a/t/relationship_doesnt_exist.t b/t/relationship_doesnt_exist.t
new file mode 100644 (file)
index 0000000..d440b52
--- /dev/null
@@ -0,0 +1,30 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;  
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 3;
+
+my $bookmark = $schema->resultset("Bookmark")->find(1);
+my $link = $bookmark->link;
+my $link_id = $link->id;
+ok $link->id;
+
+$link->delete;
+is $schema->resultset("Link")->search(id => $link_id)->count, 0,
+    "link $link_id was deleted";
+
+# Get a fresh object with nothing cached
+$bookmark = $schema->resultset("Bookmark")->find($bookmark->id);
+
+# This would create a new link row if none existed
+$bookmark->link;
+
+is $schema->resultset("Link")->search(id => $link_id)->count, 0,
+    'accessor did not create a link object where there was none';
diff --git a/t/resultset_overload.t b/t/resultset_overload.t
new file mode 100644 (file)
index 0000000..c5ecce8
--- /dev/null
@@ -0,0 +1,26 @@
+use strict;
+use warnings;  
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 6;
+
+{
+  my $rs = $schema->resultset("CD")->search({});
+
+  ok $rs->count;
+  is $rs, $rs->count, "resultset as number with results";
+  ok $rs,             "resultset as boolean always true";
+}
+
+{
+  my $rs = $schema->resultset("CD")->search({ title => "Does not exist" });
+  
+  ok !$rs->count;
+  is $rs, $rs->count, "resultset as number without results";
+  ok $rs,             "resultset as boolean always true";
+}
\ No newline at end of file