r28390 - in /branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current: Changes MANIFEST META.yml lib/MooseX/Adopt/Class/Accessor/Fast.pm lib/MooseX/Emulate/Class/Accessor/Fast.pm t/attr_named_meta.t t/no_replace_existing_symbols.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Thu Dec 18 20:57:07 UTC 2008
Author: gregoa
Date: Thu Dec 18 20:57:04 2008
New Revision: 28390
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=28390
Log:
[svn-upgrade] Integrating new upstream version, libmoosex-emulate-class-accessor-fast-perl (0.00600)
Added:
branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/attr_named_meta.t
branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/no_replace_existing_symbols.t
Modified:
branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Changes
branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/MANIFEST
branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/META.yml
branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Adopt/Class/Accessor/Fast.pm
branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Emulate/Class/Accessor/Fast.pm
Modified: branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Changes?rev=28390&op=diff
==============================================================================
--- branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Changes (original)
+++ branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/Changes Thu Dec 18 20:57:04 2008
@@ -1,3 +1,11 @@
+0.00600 Dec 17, 2008
+ - Add test for a 'meta' accessor, which we need to treat as a
+ special case (t0m)
+ - Add test for not replacing pre-existing accessors generally,
+ which is behavior we don't want to lose (t0m)
+ - Don't use ->meta
+ - Don't use ->can
+ - Attempt to support attrs named meta with no success. test marked as todo.
0.00500 Dec 9, 2008
- make_accessor, make_ro_accessor, make_rw_accessor
- tests
@@ -6,9 +14,9 @@
on badly-written code like Data::Page. (Reported by marcus)
- Tests for this
- Up Moose dep to 0.31
-0.00300 Jul XX, 2008
+0.00300 Jul 30, 2008
- Replace around 'new' with a BUILD method. Faster and avoids Moose
- bug with around/immutable and sub-classes.
+ bug with around/immutable and sub-classes. (t0m)
0.00200 Mar 28, 2008
- Extend BUILDALL to store constructor keys in the obj. hashref
- Minor fix to make sure Adopt doesn't trip PAUSE perms
Modified: branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/MANIFEST?rev=28390&op=diff
==============================================================================
--- branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/MANIFEST (original)
+++ branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/MANIFEST Thu Dec 18 20:57:04 2008
@@ -15,6 +15,8 @@
README
t/accessors.t
t/adopt.t
+t/attr_named_meta.t
t/construction.t
t/getset.t
t/lib/TestAdoptCAF.pm
+t/no_replace_existing_symbols.t
Modified: branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/META.yml?rev=28390&op=diff
==============================================================================
--- branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/META.yml (original)
+++ branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/META.yml Thu Dec 18 20:57:04 2008
@@ -19,4 +19,4 @@
Moose: 0.31
resources:
license: http://dev.perl.org/licenses/
-version: 0.00500
+version: 0.00600
Modified: branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Adopt/Class/Accessor/Fast.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Adopt/Class/Accessor/Fast.pm?rev=28390&op=diff
==============================================================================
--- branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Adopt/Class/Accessor/Fast.pm (original)
+++ branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Adopt/Class/Accessor/Fast.pm Thu Dec 18 20:57:04 2008
@@ -8,6 +8,7 @@
Class::Accessor::Fast;
use Moose;
+use namespace::clean;
with 'MooseX::Emulate::Class::Accessor::Fast';
1;
Modified: branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Emulate/Class/Accessor/Fast.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Emulate/Class/Accessor/Fast.pm?rev=28390&op=diff
==============================================================================
--- branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Emulate/Class/Accessor/Fast.pm (original)
+++ branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/lib/MooseX/Emulate/Class/Accessor/Fast.pm Thu Dec 18 20:57:04 2008
@@ -1,8 +1,10 @@
package MooseX::Emulate::Class::Accessor::Fast;
use Moose::Role;
-
-our $VERSION = '0.00500';
+use Class::MOP ();
+use Scalar::Util ();
+
+our $VERSION = '0.00600';
=head1 NAME
@@ -67,6 +69,12 @@
=cut
+my $locate_metaclass = sub {
+ my $class = Scalar::Util::blessed($_[0]) || $_[0];
+ return Class::MOP::get_metaclass_by_name($class)
+ || Moose::Meta::Class->initialize($class);
+};
+
sub BUILD {
my $self = shift;
my %args;
@@ -93,25 +101,24 @@
sub mk_accessors{
my $self = shift;
- my $meta = $self->meta;
+ my $meta = $locate_metaclass->($self);
for my $attr_name (@_){
my $reader = $self->accessor_name_for($attr_name);
my $writer = $self->mutator_name_for( $attr_name);
#dont overwrite existing methods
if($reader eq $writer){
- my %opts = ( $self->can($reader) ? () : (accessor => $reader) );
+ my %opts = ( $meta->has_method($reader) ? () : (accessor => $reader) );
my $attr = $meta->add_attribute($attr_name, %opts);
if($attr_name eq $reader){
my $alias = "_${attr_name}_accessor";
- next if $self->can($alias);
- my @alias_method = $opts{accessor} ? ( $alias => $self->can($reader) )
- : ( $attr->process_accessors(accessor => $alias, 0 ) );
+ next if $meta->has_method($alias);
+ my @alias_method = $attr->process_accessors(accessor => $alias, 0);
$meta->add_method(@alias_method);
}
} else {
- my @opts = ( $self->can($writer) ? () : (writer => $writer) );
- push(@opts, (reader => $reader)) unless $self->can($reader);
+ my @opts = ( $meta->has_method($writer) ? () : (writer => $writer) );
+ push(@opts, (reader => $reader)) unless $meta->has_method($reader);
$meta->add_attribute($attr_name, @opts);
}
}
@@ -125,14 +132,14 @@
sub mk_ro_accessors{
my $self = shift;
- my $meta = $self->meta;
+ my $meta = $locate_metaclass->($self);
for my $attr_name (@_){
my $reader = $self->accessor_name_for($attr_name);
- my @opts = ($self->can($reader) ? () : (reader => $reader) );
+ my @opts = ($meta->has_method($reader) ? () : (reader => $reader) );
my $attr = $meta->add_attribute($attr_name, @opts);
if($reader eq $attr_name && $reader eq $self->mutator_name_for($attr_name)){
$meta->add_method("_${attr_name}_accessor" => $attr->get_read_method_ref)
- unless $self->can("_${attr_name}_accessor");
+ unless $meta->has_method("_${attr_name}_accessor");
}
}
}
@@ -146,14 +153,14 @@
#this is retarded.. but we need it for compatibility or whatever.
sub mk_wo_accessors{
my $self = shift;
- my $meta = $self->meta;
+ my $meta = $locate_metaclass->($self);
for my $attr_name (@_){
my $writer = $self->mutator_name_for($attr_name);
- my @opts = ($self->can($writer) ? () : (writer => $writer) );
+ my @opts = ($meta->has_method($writer) ? () : (writer => $writer) );
my $attr = $meta->add_attribute($attr_name, @opts);
if($writer eq $attr_name && $writer eq $self->accessor_name_for($attr_name)){
$meta->add_method("_${attr_name}_accessor" => $attr->get_write_method_ref)
- unless $self->can("_${attr_name}_accessor");
+ unless $meta->has_method("_${attr_name}_accessor");
}
}
}
@@ -167,7 +174,7 @@
sub follow_best_practice{
my $self = shift;
- my $meta = $self->meta;
+ my $meta = $locate_metaclass->($self);
$meta->remove_method('mutator_name_for');
$meta->remove_method('accessor_name_for');
@@ -196,11 +203,11 @@
my $self = shift;
my $k = shift;
confess "Wrong number of arguments received" unless scalar @_;
-
- #my $writer = $self->mutator_name_for( $k );
+ my $meta = $locate_metaclass->($self);
+
confess "No such attribute '$k'"
- unless ( my $attr = $self->meta->find_attribute_by_name($k) );
- my $writer = $attr->writer || $attr->accessor;
+ unless ( my $attr = $meta->find_attribute_by_name($k) );
+ my $writer = $attr->get_write_method;
$self->$writer(@_ > 1 ? [@_] : @_);
}
@@ -213,13 +220,13 @@
sub get{
my $self = shift;
confess "Wrong number of arguments received" unless scalar @_;
-
+ my $meta = $locate_metaclass->($self);
my @values;
- #while( my $attr = $self->meta->find_attribute_by_name( shift(@_) ){
+
for( @_ ){
confess "No such attribute '$_'"
- unless ( my $attr = $self->meta->find_attribute_by_name($_) );
- my $reader = $attr->reader || $attr->accessor;
+ unless ( my $attr = $meta->find_attribute_by_name($_) );
+ my $reader = $attr->get_read_method;
@_ > 1 ? push(@values, $self->$reader) : return $self->$reader;
}
@@ -228,7 +235,7 @@
sub make_accessor {
my($class, $field) = @_;
- my $meta = $class->meta;
+ my $meta = $locate_metaclass->($class);
my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field);
my $reader = $attr->get_read_method_ref;
my $writer = $attr->get_write_method_ref;
@@ -242,7 +249,7 @@
sub make_ro_accessor {
my($class, $field) = @_;
- my $meta = $class->meta;
+ my $meta = $locate_metaclass->($class);
my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field);
return $attr->get_read_method_ref;
}
@@ -250,12 +257,11 @@
sub make_wo_accessor {
my($class, $field) = @_;
- my $meta = $class->meta;
+ my $meta = $locate_metaclass->($class);
my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field);
return $attr->get_write_method_ref;
}
-
1;
=head2 meta
Added: branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/attr_named_meta.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/attr_named_meta.t?rev=28390&op=file
==============================================================================
--- branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/attr_named_meta.t (added)
+++ branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/attr_named_meta.t Thu Dec 18 20:57:04 2008
@@ -1,0 +1,30 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+use Class::MOP ();
+use Test::More skip_all => 'TODO'; #
+use MooseX::Adopt::Class::Accessor::Fast;
+
+{
+ package TestPackage;
+ use base 'Class::Accessor::Fast';
+ __PACKAGE__->mk_accessors(qw/ meta /);
+}
+
+my $i = TestPackage->new( meta => 66 );
+
+is $i->meta, 66, 'meta accessor read value from constructor';
+$i->meta(9);
+is $i->meta, 9, 'meta accessor read set value';
+
+my $meta = Class::MOP::get_metaclass_for('TestPackage');
+$meta->make_immutable;
+
+is $i->meta, 9, 'meta accessor read value from constructor';
+$i->meta(66);
+is $i->meta, 66, 'meta accessor read set value';
+
+
+__END__;
+
Added: branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/no_replace_existing_symbols.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/no_replace_existing_symbols.t?rev=28390&op=file
==============================================================================
--- branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/no_replace_existing_symbols.t (added)
+++ branches/upstream/libmoosex-emulate-class-accessor-fast-perl/current/t/no_replace_existing_symbols.t Thu Dec 18 20:57:04 2008
@@ -1,0 +1,36 @@
+#!/usr/binperl -w
+
+use strict;
+use warnings;
+use Test::More tests => 6;
+
+{
+ package SomeClass;
+ use Moose;
+ with 'MooseX::Emulate::Class::Accessor::Fast';
+
+ sub anaccessor { 'wibble' }
+
+}
+{
+ package SubClass;
+ use base qw/SomeClass/;
+
+ sub anotherone { 'flibble' }
+ __PACKAGE__->mk_accessors(qw/ anaccessor anotherone /);
+}
+
+# 1, 2
+my $someclass = SomeClass->new;
+is($someclass->anaccessor, 'wibble');
+$someclass->anaccessor('fnord');
+is($someclass->anaccessor, 'wibble');
+
+# 3-6
+my $subclass = SubClass->new;
+ok( not defined $subclass->anaccessor );
+$subclass->anaccessor('fnord');
+is($subclass->anaccessor, 'fnord');
+is($subclass->anotherone, 'flibble');
+$subclass->anotherone('fnord');
+is($subclass->anotherone, 'flibble');
More information about the Pkg-perl-cvs-commits
mailing list