Revision history for Mouse
+0.64
+ [BUG FIXES]
+ * Build failure on 5.13.3
+
+ [CHANGES]
+ * Illegal inheritance options for clone_and_inherit_options()
+ is now a black list, not a white list (Moose 1.09 feature)
+ * Remove long deprecated methods in Mouse::Meta::Attribute:
+ clone_parent, get_parent_args, canonicalize_args, create
+
0.63 Tue Jul 20 19:26:30 2010
[CHANGES]
* Resolve RT#59460: Test::Requires is not a required prerequisite unless
export_to_level => sub {
my($package, $level, undef, @args) = @_; # the third argument is redundant
-
- Carp::carp("$package->export_to_level has been deprecated."
- ." Use $package->import({ into_level => LEVEL }) instead");
$package->import({ into_level => $level + 1 }, @args);
},
export => sub {
my($package, $into, @args) = @_;
- Carp::carp("$package->export has been deprecated."
- ." Use $package->import({ into => PACKAGE }) instead");
$package->import({ into => $into }, @args);
},
);
my $args = $class->Mouse::Object::BUILDARGS(@_);
- # XXX: for backward compatibility (with method modifiers)
- if($class->can('canonicalize_args') != \&canonicalize_args){
- %{$args} = $class->canonicalize_args($name, %{$args});
- }
-
$class->_process_options($name, $args);
$args->{name} = $name;
return( $class, @traits );
}
-sub canonicalize_args{ # DEPRECATED
- #my($self, $name, %args) = @_;
- my($self, undef, %args) = @_;
-
- Carp::cluck("$self->canonicalize_args has been deprecated."
- . "Use \$self->_process_options instead.");
-
- return %args;
-}
-
-sub create { # DEPRECATED
- #my($self, $class, $name, %args) = @_;
- my($self) = @_;
-
- Carp::cluck("$self->create has been deprecated."
- . "Use \$meta->add_attribute and \$attr->install_accessors instead.");
-
- # noop
- return $self;
-}
-
sub _coerce_and_verify {
#my($self, $value, $instance) = @_;
my($self, $value) = @_;
return $attribute_class->new($self->name, $args);
}
-sub clone_parent { # DEPRECATED
- my $self = shift;
- my $class = shift;
- my $name = shift;
- my %args = ($self->get_parent_args($class, $name), @_);
-
- Carp::cluck("$self->clone_parent has been deprecated."
- . "Use \$meta->add_attribute and \$attr->install_accessors instead.");
-
- $self->clone_and_inherited_args($class, $name, %args);
-}
-
-sub get_parent_args { # DEPRECATED
- my $self = shift;
- my $class = shift;
- my $name = shift;
-
- for my $super ($class->linearized_isa) {
- my $super_attr = $super->can("meta") && $super->meta->get_attribute($name)
- or next;
- return %{ $super_attr->_create_args };
- }
-
- $self->throw_error("Could not find an attribute by the name of '$name' to inherit from");
-}
-
-
sub get_read_method {
return $_[0]->reader || $_[0]->accessor
}
}
}
- if($attribute->can('create') != \&create){
- # backword compatibility
- $attribute->create($metaclass, $attribute->name, %{$attribute});
- }
-
return;
}
+++ /dev/null
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 2;
-use lib 't/lib';
-
-do {
- local $SIG{__WARN__} = sub{ $_[0] =~ /deprecated/ or warn @_ };
-
- package MouseX::AttributeHelpers::Number;
- use Mouse;
- extends 'Mouse::Meta::Attribute';
-
- sub create {
- my ($self, @args) = @_;
- my $attr = $self->SUPER::create(@args);
- my %provides = %{$attr->{provides}};
- my $method_constructors = {
- add => sub {
- my ($attr, $name) = @_;
- return sub {
- $_[0]->$name( $_[0]->$name() + $_[1])
- };
- },
- };
- while (my ($name, $aliased) = each %provides) {
- $attr->associated_class->add_method(
- $aliased => $method_constructors->{$name}->($attr, $attr->name)
- );
- }
- return $attr;
- };
-
- around 'canonicalize_args' => sub {
- my ($next, $self, $name, %args) = @_;
-
- %args = $next->($self, $name, %args);
- $args{is} = 'rw' unless exists $args{is};
-
- return %args;
- };
-
- package # hide me from search.cpan.org
- Mouse::Meta::Attribute::Custom::Number;
- sub register_implementation { 'MouseX::AttributeHelpers::Number' }
-
- 1;
-
- package Klass;
- use Mouse;
-
- has 'number' => (
- metaclass => 'Number',
- isa => 'Int',
- provides => {
- 'add' => 'add_number'
- },
- );
-};
-
-can_ok 'Klass', 'add_number', 'number';
-my $k = Klass->new(number => 3);
-$k->add_number(4);
-is $k->number, 7;
-
+++ /dev/null
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 7;
-use lib 't/lib';
-
-do {
- local $SIG{__WARN__} = sub{ $_[0] =~ /deprecated/ or warn @_ };
-
- package MouseX::AttributeHelpers::Number;
- use Mouse;
- extends 'Mouse::Meta::Attribute';
-
- sub create {
- my ($self, @args) = @_;
- my $attr = $self->SUPER::create(@args);
- my %provides = %{$attr->{provides}};
- my $method_constructors = {
- add => sub {
- my ($attr, $name) = @_;
- return sub {
- $_[0]->$name( $_[0]->$name() + $_[1])
- };
- },
- };
- while (my ($name, $aliased) = each %provides) {
- $attr->associated_class->add_method(
- $aliased => $method_constructors->{$name}->($attr, $attr->name)
- );
- }
- return $attr;
- };
-
- package # hide me from search.cpan.org
- Mouse::Meta::Attribute::Custom::Number;
- sub register_implementation { 'MouseX::AttributeHelpers::Number' }
-
- 1;
-
- package Foo;
- use Mouse::Role;
-
- has 'i' => (
- metaclass => 'Number',
- is => 'rw',
- isa => 'Int',
- provides => {
- 'add' => 'add_number'
- },
- );
- sub f_m {}
-
- package Bar;
- use Mouse::Role;
-
- has 'j' => (
- metaclass => 'Number',
- is => 'rw',
- isa => 'Int',
- provides => {
- 'add' => 'add_number_j'
- },
- );
- sub b_m {}
-
- package Klass1;
- use Mouse;
- with 'Foo';
-
- package Klass2;
- use Mouse;
- with 'Foo', 'Bar';
-
-};
-
-{
- # normal
- can_ok 'Klass1', 'add_number';
- my $k = Klass1->new(i=>3);
- $k->add_number(4);
- is $k->i, 7;
-}
-
-{
- # combine
- can_ok 'Klass2', 'f_m';
- can_ok 'Klass2', 'b_m';
- can_ok 'Klass2', 'add_number';
- can_ok 'Klass2', 'add_number_j';
- my $k = Klass2->new(i=>3);
- $k->add_number(4);
- is $k->i, 7;
-}
-
-