[Catalyst-commits] r7990 - in Catalyst-Runtime/5.80/trunk: .
lib/Catalyst t
groditi at dev.catalyst.perl.org
groditi at dev.catalyst.perl.org
Mon Jun 23 22:20:54 BST 2008
Author: groditi
Date: 2008-06-23 22:20:54 +0100 (Mon, 23 Jun 2008)
New Revision: 7990
Added:
Catalyst-Runtime/5.80/trunk/t/unit_core_classdata.t
Modified:
Catalyst-Runtime/5.80/trunk/
Catalyst-Runtime/5.80/trunk/lib/Catalyst/AttrContainer.pm
Catalyst-Runtime/5.80/trunk/lib/Catalyst/ClassData.pm
Catalyst-Runtime/5.80/trunk/lib/Catalyst/Component.pm
Log:
r18426 at martha (orig r7904): groditi | 2008-06-09 16:00:14 -0400
still failing some tests. waiting for suggestions on whether to fix old CDIretardedness
Property changes on: Catalyst-Runtime/5.80/trunk
___________________________________________________________________
Name: svk:merge
- 1c72fc7c-9ce4-42af-bf25-3bfe470ff1e8:/local/Catalyst/trunk/Catalyst-Runtime:9763
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.70/trunk:7576
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.80/branches/moose:7903
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-ChildOf:4443
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-Runtime-jrockway:5857
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-component-setup:4320
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-docs:4325
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/current/Catalyst-Runtime:5142
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst:4483
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst-Runtime:6165
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime:8339
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime-jrockway:8342
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime:6511
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime-current:10442
+ 1c72fc7c-9ce4-42af-bf25-3bfe470ff1e8:/local/Catalyst/trunk/Catalyst-Runtime:9763
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.70/trunk:7576
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.80/branches/moose:7904
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-ChildOf:4443
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-Runtime-jrockway:5857
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-component-setup:4320
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-docs:4325
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/current/Catalyst-Runtime:5142
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst:4483
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst-Runtime:6165
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime:8339
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime-jrockway:8342
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime:6511
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime-current:10442
Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/AttrContainer.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/AttrContainer.pm 2008-06-23 21:20:47 UTC (rev 7989)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/AttrContainer.pm 2008-06-23 21:20:54 UTC (rev 7990)
@@ -4,6 +4,7 @@
use Catalyst::Exception;
with 'Catalyst::ClassData';
+use Scalar::Util 'blessed';
no Moose;
Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/ClassData.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/ClassData.pm 2008-06-23 21:20:47 UTC (rev 7989)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/ClassData.pm 2008-06-23 21:20:54 UTC (rev 7990)
@@ -1,6 +1,7 @@
package Catalyst::ClassData;
use Moose::Role;
+use Class::MOP;
use Scalar::Util 'blessed';
sub mk_classdata {
@@ -11,19 +12,20 @@
my $slot = '$'.$attribute;
my $accessor = sub {
if(@_ > 1){
- $_[0]->meta->add_package_symbol($slot, \ $_[1]);
+ $_[0]->meta->add_package_symbol($slot, \ $_[1]);
return $_[1];
}
- foreach my $super ( $_[0], $_[0]->meta->linearized_isa ) {
- my $meta = $super->meta;
+
+ foreach my $super ( (blessed $_[0] || $_[0]), $_[0]->meta->linearized_isa ) {
+ my $meta = Moose::Meta::Class->initialize($super);
if( $meta->has_package_symbol($slot) ){
- return $meta->get_package_symbol($slot);
+ return ${ $meta->get_package_symbol($slot) };
}
}
return;
};
- my $accessor = eval $code;
- confess("Failed to create accessor: $@ \n $code \n")
+
+ confess("Failed to create accessor: $@ ")
unless ref $accessor eq 'CODE';
my $meta = $class->meta;
@@ -37,18 +39,3 @@
1;
__END__
-
-# my $code = ' sub {
-# if(@_ > 1){
-# $_[0]->meta->add_package_symbol(\''.$slot.'\', \ $_[1]);
-# return $_[1];
-# }
-# foreach my $super ( $_[0], $_[0]->meta->linearized_isa ) {
-# my $meta = $super->meta;
-# if( $meta->has_package_symbol(\''.$slot.'\') ){
-# return $meta->get_package_symbol(\''.$slot.'\');
-# }
-# }
-# return;
-# }';
-# my $accessor = eval $code;
Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Component.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Component.pm 2008-06-23 21:20:47 UTC (rev 7989)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Component.pm 2008-06-23 21:20:54 UTC (rev 7990)
@@ -84,29 +84,12 @@
sub config {
my $self = shift;
- my $config_sub = $self->can('_config');
- my $config = $self->$config_sub() || {};
+ my $config = $self->_config ||{};
if (@_) {
my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} };
$self->_config(
$self->merge_config_hashes( $config, $newconfig )
);
- } else {
- # this is a bit of a kludge, required to make
- # __PACKAGE__->config->{foo} = 'bar';
- # work in a subclass. Calling the Class::Data::Inheritable setter
- # will create a new _config method in the current class if it's
- # currently inherited from the superclass. So, the can() call will
- # return a different subref in that case and that means we know to
- # copy and reset the value stored in the class data.
-
- $self->_config( $config );
-
- if ((my $config_sub_now = $self->can('_config')) ne $config_sub) {
-
- $config = $self->merge_config_hashes( $config, {} );
- $self->$config_sub_now( $config );
- }
}
return $config;
}
Added: Catalyst-Runtime/5.80/trunk/t/unit_core_classdata.t
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/unit_core_classdata.t (rev 0)
+++ Catalyst-Runtime/5.80/trunk/t/unit_core_classdata.t 2008-06-23 21:20:54 UTC (rev 7990)
@@ -0,0 +1,84 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Scalar::Util qw/refaddr blessed/;
+use Test::More tests => 32;
+
+{
+ package ClassDataTest;
+ use Moose;
+ with 'Catalyst::ClassData';
+
+ package ClassDataTest2;
+ use Moose;
+ extends 'ClassDataTest';
+
+}
+
+ my $scalar = '100';
+ my $arrayref = [];
+ my $hashref = {};
+ my $scalarref = \$scalar;
+ my $coderef = sub { "beep" };
+
+ my $scalar2 = '200';
+ my $arrayref2 = [];
+ my $hashref2 = {};
+ my $scalarref2 = \$scalar2;
+ my $coderef2 = sub { "beep" };
+
+
+my @accessors = qw/_arrayref _hashref _scalarref _coderef _scalar/;
+ClassDataTest->mk_classdata($_) for @accessors;
+can_ok('ClassDataTest', @accessors);
+
+ClassDataTest2->mk_classdata("beep", "meep");
+is(ClassDataTest2->beep, "meep");
+
+ClassDataTest->_arrayref($arrayref);
+ClassDataTest->_hashref($hashref);
+ClassDataTest->_scalarref($scalarref);
+ClassDataTest->_coderef($coderef);
+ClassDataTest->_scalar($scalar);
+
+is(ref(ClassDataTest->_arrayref), 'ARRAY');
+is(ref(ClassDataTest->_hashref), 'HASH');
+is(ref(ClassDataTest->_scalarref), 'SCALAR');
+is(ref(ClassDataTest->_coderef), 'CODE');
+ok( !ref(ClassDataTest->_scalar) );
+is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref));
+is(refaddr(ClassDataTest->_hashref), refaddr($hashref));
+is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref));
+is(refaddr(ClassDataTest->_coderef), refaddr($coderef));
+is(ClassDataTest->_scalar, $scalar);
+
+
+is(ref(ClassDataTest2->_arrayref), 'ARRAY');
+is(ref(ClassDataTest2->_hashref), 'HASH');
+is(ref(ClassDataTest2->_scalarref), 'SCALAR');
+is(ref(ClassDataTest2->_coderef), 'CODE');
+ok( !ref(ClassDataTest2->_scalar) );
+is(refaddr(ClassDataTest2->_arrayref), refaddr($arrayref));
+is(refaddr(ClassDataTest2->_hashref), refaddr($hashref));
+is(refaddr(ClassDataTest2->_scalarref), refaddr($scalarref));
+is(refaddr(ClassDataTest2->_coderef), refaddr($coderef));
+is(ClassDataTest2->_scalar, $scalar);
+
+ClassDataTest2->_arrayref($arrayref2);
+ClassDataTest2->_hashref($hashref2);
+ClassDataTest2->_scalarref($scalarref2);
+ClassDataTest2->_coderef($coderef2);
+ClassDataTest2->_scalar($scalar2);
+
+is(refaddr(ClassDataTest2->_arrayref), refaddr($arrayref2));
+is(refaddr(ClassDataTest2->_hashref), refaddr($hashref2));
+is(refaddr(ClassDataTest2->_scalarref), refaddr($scalarref2));
+is(refaddr(ClassDataTest2->_coderef), refaddr($coderef2));
+is(ClassDataTest2->_scalar, $scalar2);
+
+is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref));
+is(refaddr(ClassDataTest->_hashref), refaddr($hashref));
+is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref));
+is(refaddr(ClassDataTest->_coderef), refaddr($coderef));
+is(ClassDataTest->_scalar, $scalar);
More information about the Catalyst-commits
mailing list