From: Florian Ragwitz <rafl@debian.org>
Date: Mon, 9 May 2011 16:20:57 +0000 (+0200)
Subject: Allow changing attributes on schema cloning
X-Git-Tag: v0.08193~32
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=71829446a4a4520d835971cf8376297d57315940;p=dbsrgits%2FDBIx-Class.git

Allow changing attributes on schema cloning
---

diff --git a/Changes b/Changes
index cfaacab..234c658 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,10 @@
 Revision history for DBIx::Class
 
+
+    * New Features / Changes
+        - Allow schema cloning to mutate attributes.
+
+    * Fixes
         - Fix issue where the query was becoming overly mangled when trying
           to use pagination with a query that has a sub-select in the WHERE
           clause.
diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 36c7e16..033c0b7 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -1004,18 +1004,25 @@ sub svp_rollback {
 
 =over 4
 
+=item Arguments: %attrs?
+
 =item Return Value: $new_schema
 
 =back
 
 Clones the schema and its associated result_source objects and returns the
-copy.
+copy. The resulting copy will have the same attributes as the source schema,
+except for those attributes explicitly overriden by the provided C<%attrs>.
 
 =cut
 
 sub clone {
-  my ($self) = @_;
-  my $clone = { (ref $self ? %$self : ()) };
+  my $self = shift;
+
+  my $clone = {
+      (ref $self ? %$self : ()),
+      (@_ == 1 && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_),
+  };
   bless $clone, (ref $self || $self);
 
   $clone->class_mappings({ %{$clone->class_mappings} });
diff --git a/t/lib/DBICTest/Schema.pm b/t/lib/DBICTest/Schema.pm
index 07b311a..937aa77 100644
--- a/t/lib/DBICTest/Schema.pm
+++ b/t/lib/DBICTest/Schema.pm
@@ -5,6 +5,8 @@ use base qw/DBIx::Class::Schema/;
 
 no warnings qw/qw/;
 
+__PACKAGE__->mk_group_accessors(simple => 'custom_attr');
+
 __PACKAGE__->load_classes(qw/
   Artist
   SequenceTest
diff --git a/t/schema/clone.t b/t/schema/clone.t
index 8bc729f..86b7a47 100644
--- a/t/schema/clone.t
+++ b/t/schema/clone.t
@@ -7,7 +7,21 @@ use DBICTest;
 
 my $schema = DBICTest->init_schema();
 
-my $clone = $schema->clone;
-cmp_ok ($clone->storage, 'eq', $schema->storage, 'Storage copied into new schema (not a new instance)');
+{
+  my $clone = $schema->clone;
+  cmp_ok ($clone->storage, 'eq', $schema->storage, 'Storage copied into new schema (not a new instance)');
+}
+
+{
+  is $schema->custom_attr, undef;
+  my $clone = $schema->clone(custom_attr => 'moo');
+  is $clone->custom_attr, 'moo', 'cloning can change existing attrs';
+}
+
+{
+  my $clone = $schema->clone({ custom_attr => 'moo' });
+  is $clone->custom_attr, 'moo', 'cloning can change existing attrs';
+}
+
 
 done_testing;