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

Report information
The Basics
Id:
51228
Status:
open
Priority:
Low/Low

People
Owner:
Nobody in particular
Requestors:
shay [...] cpan.org
Cc:
AdminCc:

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



Subject: [PATCH] Use named subroutines
It is useful when debugging programs that use generated accessor methods if those methods are named rather than anonymous. The attached patch names accessors generated by Class::Data::Inheritable using the Sub::Name module if that is available. If it isn't available then there is no change. The patch is based on the code in Class::Accessor, and also incorporates a patch on RT #6281: http://rt.cpan.org/Public/Bug/Display.html?id=6281 to avoid overwriting existing subroutines.
Subject: subname.patch
diff -ruN Class-Data-Inheritable-0.08.orig/README Class-Data-Inheritable-0.08/README --- Class-Data-Inheritable-0.08.orig/README 2008-01-25 11:37:02.000000000 +0000 +++ Class-Data-Inheritable-0.08/README 2009-11-09 12:41:00.335444500 +0000 @@ -85,6 +85,9 @@ $self->_Suitcase_accessor(@_); } + The accessor and its alias will each not be created if a subroutine of + the same name already exists. + AUTHOR Original code by Damian Conway. diff -ruN Class-Data-Inheritable-0.08.orig/lib/Class/Data/Inheritable.pm Class-Data-Inheritable-0.08/lib/Class/Data/Inheritable.pm --- Class-Data-Inheritable-0.08.orig/lib/Class/Data/Inheritable.pm 2008-01-25 11:51:00.000000000 +0000 +++ Class-Data-Inheritable-0.08/lib/Class/Data/Inheritable.pm 2009-11-09 13:29:29.369687200 +0000 @@ -4,6 +4,10 @@ use vars qw($VERSION); $VERSION = '0.08'; +if (eval { require Sub::Name }) { + Sub::Name->import; +} + sub mk_classdata { my ($declaredclass, $attribute, $data) = @_; @@ -22,9 +26,18 @@ return $data; }; - my $alias = "_${attribute}_accessor"; - *{$declaredclass.'::'.$attribute} = $accessor; - *{$declaredclass.'::'.$alias} = $accessor; + my $name = "${declaredclass}::$attribute"; + my $subnamed = 0; + unless (defined &{$name}) { + subname($name, $accessor) if defined &subname; + $subnamed = 1; + *{$name} = $accessor; + } + my $alias = "${declaredclass}::_${attribute}_accessor"; + unless (defined &{$alias}) { + subname($alias, $accessor) if defined &subname and not $subnamed; + *{$alias} = $accessor; + } } 1; @@ -123,6 +136,9 @@ $self->_Suitcase_accessor(@_); } +The accessor and its alias will each not be created if a subroutine of +the same name already exists. + =head1 AUTHOR Original code by Damian Conway. diff -ruN Class-Data-Inheritable-0.08.orig/t/Inheritable.t Class-Data-Inheritable-0.08/t/Inheritable.t --- Class-Data-Inheritable-0.08.orig/t/Inheritable.t 2005-09-24 14:52:16.000000000 +0100 +++ Class-Data-Inheritable-0.08/t/Inheritable.t 2009-11-09 12:44:45.946263400 +0000 @@ -1,10 +1,13 @@ use strict; -use Test::More tests => 15; +use Test::More tests => 17; package Ray; use base qw(Class::Data::Inheritable); Ray->mk_classdata('Ubu'); Ray->mk_classdata(DataFile => '/etc/stuff/data'); +Ray->mk_classdata(foo => 1); +sub foo { return 2 } +sub _foo_accessor { return 3 } package Gun; use base qw(Ray); @@ -44,3 +47,7 @@ "Can't create classdata for an object"; is $obj->DataFile, "/tmp/stuff", "But objects can access the data"; + +# Existing subroutines should not be overwritten +is +Ray->foo, '2', "Existing name is not ovewrwritten"; +is +Ray->_foo_accessor, '3', "Existing alias is not ovewrwritten";
On Mon Nov 09 08:40:31 2009, SHAY wrote:
Show quoted text
> It is useful when debugging programs that use generated accessor methods > if those methods are named rather than anonymous. > > The attached patch names accessors generated by Class::Data::Inheritable > using the Sub::Name module if that is available. If it isn't available > then there is no change. > > The patch is based on the code in Class::Accessor, and also incorporates > a patch on RT #6281: > > http://rt.cpan.org/Public/Bug/Display.html?id=6281 > > to avoid overwriting existing subroutines.
FYI, I've just applied an exactly similar patch to the related Class-Data-Inheritable-Translucent distribution (version 1.01).


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.