Re: subclassing, relationship, has_a problem patch, revisited

[prev] [thread] [next] [Date index for 2005/01/16]

This is a multi-part message in MIME format.
--------------080704020504060006010709
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
Content-Transfer-Encoding: 7bit

Hello All,

Here is improved patch that correctly handles sub refs cloning.

Sincerely,
Aleksandr

--------------080704020504060006010709
Content-Type: text/plain;
 name="Class-DBI-0.96-relationship.patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="Class-DBI-0.96-relationship.patch"

diff -ru /home/ag/.cpan/build/Class-DBI-0.96/lib/Class/DBI.pm ./lib/Class/DBI.pm
--- /home/ag/.cpan/build/Class-DBI-0.96/lib/Class/DBI.pm	2004-04-30 10:22:12.000000000 +0300
+++ ./lib/Class/DBI.pm	2005-01-16 18:09:03.503027384 +0200
@@ -19,6 +19,8 @@
 use Carp ();
 use List::Util;
 use UNIVERSAL::moniker;
+use Storable ();
+$Storable::Deparse = $Storable::Eval = 1;
 
 use vars qw($Weaken_Is_Available);
 
@@ -1021,7 +1023,7 @@
 
 sub _extend_meta {
 	my ($class, $type, $subtype, $val) = @_;
-	my %hash = %{ $class->__meta_info || {} };
+	my %hash = %{ $class->__meta_info ? Storable::dclone($class->__meta_info) : {} };
 	$hash{$type}->{$subtype} = $val;
 	$class->__meta_info(\%hash);
 }
diff -ru /home/ag/.cpan/build/Class-DBI-0.96/t/03-subclassing.t ./t/03-subclassing.t
--- /home/ag/.cpan/build/Class-DBI-0.96/t/03-subclassing.t	2003-03-02 16:54:57.000000000 +0200
+++ ./t/03-subclassing.t	2005-01-16 18:07:47.195627872 +0200
@@ -7,16 +7,20 @@
 
 BEGIN {
 	eval "use DBD::SQLite";
-	plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 6);
+	plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 8);
 	use lib 't/testlib';
 	use Film;
 	Film->CONSTRUCT;
 }
 
 INIT {
+	Film->has_a(Director => 'Director',
+	            inflate => sub {} );
 
 	package Film::Threat;
 	use base 'Film';
+	
+	Film::Threat->has_a(Director => 'OtherDirector');
 }
 
 package main;
@@ -29,3 +33,6 @@
 isa_ok $btaste => "Film::Threat";
 isa_ok $btaste => "Film";
 is $btaste->Title, 'Bad Taste', 'subclass get()';
+
+ok(Film::Threat->meta_info(has_a => 'director')->foreign_class eq 'OtherDirector', "subclass has_a");
+ok(Film->meta_info(has_a => 'director')->foreign_class eq 'Director', "subclass has_a shouldn't break inhertited class");
diff -ru /home/ag/.cpan/build/Class-DBI-0.96/t/07-Move.t ./t/07-Move.t
--- /home/ag/.cpan/build/Class-DBI-0.96/t/07-Move.t	2003-07-28 18:10:37.000000000 +0300
+++ ./t/07-Move.t	2005-01-15 15:43:06.000000000 +0200
@@ -3,7 +3,7 @@
 
 BEGIN {
 	eval "use DBD::SQLite";
-	plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 23);
+	plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 33);
 }
 
 INIT {

--------------080704020504060006010709--