subclassing, relationship, has_a problem patch

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

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

Hello All,

Here is a patch to Class::DBI 0.96 for a prolem,
mentionned here earlier, which fixes the bug, mentionned here:

http://www.spanner.org/lists/cdbi/2004/06/30/1c43b009.html

Hope it will make someone's life easier

The patch is attached

Sincerely,
Aleksandr Guidrevitch

--------------020309010507070308030208
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 .cpan/build/Class-DBI-0.96/lib/Class/DBI.pm /home/ag/build/Class-DBI-0.96/lib/Class/DBI.pm
--- .cpan/build/Class-DBI-0.96/lib/Class/DBI.pm	2004-04-30 10:22:12.000000000 +0300
+++ /home/ag/build/Class-DBI-0.96/lib/Class/DBI.pm	2005-01-15 15:16:45.000000000 +0200
@@ -19,6 +19,7 @@
 use Carp ();
 use List::Util;
 use UNIVERSAL::moniker;
+use Storable ();
 
 use vars qw($Weaken_Is_Available);
 
@@ -1021,7 +1022,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 .cpan/build/Class-DBI-0.96/t/03-subclassing.t /home/ag/build/Class-DBI-0.96/t/03-subclassing.t
--- .cpan/build/Class-DBI-0.96/t/03-subclassing.t	2003-03-02 16:54:57.000000000 +0200
+++ /home/ag/build/Class-DBI-0.96/t/03-subclassing.t	2005-01-15 15:41:22.398699544 +0200
@@ -7,16 +7,19 @@
 
 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');
 
 	package Film::Threat;
 	use base 'Film';
+	
+	Film::Threat->has_a(Director => 'OtherDirector');
 }
 
 package main;
@@ -29,3 +32,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 .cpan/build/Class-DBI-0.96/t/07-Move.t /home/ag/build/Class-DBI-0.96/t/07-Move.t
--- .cpan/build/Class-DBI-0.96/t/07-Move.t	2003-07-28 18:10:37.000000000 +0300
+++ /home/ag/build/Class-DBI-0.96/t/07-Move.t	2005-01-15 15:43:06.402888504 +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 {

--------------020309010507070308030208--