This queue is for tickets about the Class-DBI CPAN distribution.

Report information
The Basics
Id:
14878
Status:
resolved
Priority:
Low/Low
Queue:

People
Owner:
Nobody in particular
Requestors:
will [...] spanner.org
Cc:
AdminCc:

BugTracker
Severity:
Important
Broken in:
0.96
Fixed in:
(no value)



Subject: meta_info entries shared among classes
If you declare relationships in your base class and then again in a data class, the __meta_info hash will end up containing hash references that are shared among classes. This severely buggers up relationship definitions, of course. It's because this (in Class::DBI::_extend_meta): my %hash = %{ $class->__meta_info || {} }; $hash{$type}->{$subtype} = $val; $class->__meta_info(\%hash); dereferences the main metadata hash, but it doesn't dereference $hash{$type}. If there's already a hashref there - because we're inheriting from a class that defined a relationship of that type - then it will be shared. In short, if you define a has_a relationship in your base class then all the has_a relationships of all your classes will be assigned to all your classes. this isn't such an odd thing to do, either. i triggered the bug with this: __PACKAGE__->columns(DATE => qw( date cdate )); __PACKAGE__->has_a( date => 'Delivery::Machinery::Date' ); __PACKAGE__->has_a( cdate => 'Delivery::Machinery::Date' ); which is true of all the classes in this particular application. The fix is easy, if a little bodgy. Just add an extra dereference to Class::DBI::_extend_meta: sub _extend_meta { my ($class, $type, $subtype, $val) = @_; my %hash = %{ $class->__meta_info || {} }; my %subhash = %{ $hash{$type} || {} }; $subhash{$subtype} = $val; $hash{$type} = \%subhash; $class->__meta_info(\%hash); } best will
Date: Mon, 3 Oct 2005 09:34:07 +0100
From: Tony Bowden <tony@kasei.com>
To: Guest via RT <bug-Class-DBI@rt.cpan.org>
Subject: Re: [cpan #14878] meta_info entries shared among classes
RT-Send-Cc:
On Sun, Oct 02, 2005 at 11:12:19AM -0400, Guest via RT wrote:
Show quoted text
> If you declare relationships in your base class and then again in a > data class, the __meta_info hash will end up containing hash references > that are shared among classes. This severely buggers up relationship > definitions, of course.
I think I understand the problem, but do you have a standalone test case that shows it? I'll be able to fix it much quicker if I have a failing test. Thanks, Tony
From: will@spanner.org
it's very easy to demonstrate, as it turns out. Comment out line 10 (My::DBI->has_a(date => ...)) and the problem goes away. will
#!/usr/bin/perl use strict; package My::DBI; use strict; use base qw(Class::DBI); use DateTime; My::DBI->connection('dbi:SQLite:dbname=test.db'); My::DBI->columns(Date => qw(date)); My::DBI->has_a(date => 'DateTime', inflate => sub { DateTime->from_epoch( epoch => shift) }, deflate => sub { shift->epoch }); package My::Person; use strict; use base qw(My::DBI); My::Person->table('people'); My::Person->columns(Essential => qw(id title pet)); My::Person->has_a( pet => 'My::Pet' ); package My::Pet; use strict; use base qw(My::DBI); My::Pet->table('pets'); My::Pet->columns(Essential => qw(id title pet_type)); package main; use Data::Dumper; die "busted\n" if scalar( My::Pet->meta_info('has_a') eq scalar( My::Person->meta_info('has_a') ) ); print "not busted\n";
Date: Mon, 3 Oct 2005 11:58:02 +0100
From: Tony Bowden <tony@kasei.com>
To: via RT <bug-Class-DBI@rt.cpan.org>
Subject: Re: [cpan #14878] meta_info entries shared among classes
RT-Send-Cc:
On Mon, Oct 03, 2005 at 05:20:15AM -0400, via RT wrote:
Show quoted text
> it's very easy to demonstrate, as it turns out. Comment out line 10 (My::DBI->has_a(date > => ...)) and the problem goes away.
Can you bundle this up as an actual test file that I can that fails a Test::More test and passes once the fix is applied? Tony
From: will@spanner.org
Failing test case 24-meta_info.t is attached. It tests that the has_a meta_info of package A is not the same variable as the has_a meta_info of package B. With the suggested fix, this test passes with 3.0.8. I'll attach a diff to the next message.
use strict; use Test::More; plan (tests => 1); package Temp::Date; sub up { 1 } sub down { 1 } package Temp::DBI; use strict; use base qw(Class::DBI); Temp::DBI->connection('dbi:SQLite:dbname=test.db'); Temp::DBI->columns(Date => qw(date)); Temp::DBI->has_a( date => 'Temp::Date', inflate => 'up', deflate => 'down' ); package Temp::Person; use strict; use base qw(Temp::DBI); Temp::Person->table('people'); Temp::Person->columns(Essential => qw(id title pet)); Temp::Person->has_a( pet => 'Temp::Pet' ); package Temp::Pet; use strict; use base qw(Temp::DBI); Temp::Pet->table('pets'); Temp::Pet->columns(Essential => qw(id title)); package main; isnt( scalar(Temp::Pet->meta_info('has_a')), scalar(Temp::Person->meta_info('has_a')), 'meta_info unshared' );
From: will@spanner.org
It's hardly worth a patch for such an obvious change, but here it is. I vaguely recall that you prefer diff -Bub, so that's what i've used. This is against 3.0.8.
--- lib/Class/DBI.orig.pm 2005-10-03 12:29:28.000000000 +0100 +++ lib/Class/DBI.pm 2005-10-03 12:40:13.000000000 +0100 @@ -1030,7 +1030,9 @@ sub _extend_meta { my ($class, $type, $subtype, $val) = @_; my %hash = %{ $class->__meta_info || {} }; - $hash{$type}->{$subtype} = $val; + my %subhash = %{ $hash{$type} || {} }; + $subhash{$subtype} = $val; + $hash{$type} = \%subhash; $class->__meta_info(\%hash); }
Date: Tue, 4 Oct 2005 08:03:26 +0100
From: Tony Bowden <tony@kasei.com>
To: via RT <bug-Class-DBI@rt.cpan.org>
Subject: Re: [cpan #14878] meta_info entries shared among classes
RT-Send-Cc:
On Mon, Oct 03, 2005 at 07:47:09AM -0400, via RT wrote:
Show quoted text
> Failing test case 24-meta_info.t is attached. It tests that the has_a meta_info of package A is > not the same variable as the has_a meta_info of package B.
I've changed the test to actually test for the problem as it exhibits itself. ie to check that Pet doesn't have a Pet. Testing the equality of the hashref isn't really enough as they could be copies with the same information.
Show quoted text
> With the suggested fix, this test passes with 3.0.8. I'll attach a > diff to the next message.
I've changed this to just use dclone(), so we don't need to traverse the whole way down the hash. Should be released later today. Thanks, Tony


This service runs on Request Tracker, is sponsored by The Perl Foundation, and maintained by Best Practical Solutions.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.